Search code examples
vbamergeexcel-2003conditional-formatting

VBA conditional formatting based on contents of merged cells


I have a spreadsheet set up like this:

1   Basic Rota  09:00   13:00
2   Absence           S 

If you imagine the column labels start above 'Basic Rota' as A, B and C. The Absence cell (B2:C2) is a merged cell which can contain either 'H','S','T','SC' or it can be empty. Based on the contents of that cell, B1 and C1 should change colour. I have a bit of VBA which does the job.

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit


Private Sub Worksheet_Change(ByVal Selection As Range)

        Select Case Target.Value

    Case "S"

        Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 53
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 53
        Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 53
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 53

    Case "H"

        Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 50
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 50
        Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 50
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 50

    Case "T"

        Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 44
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 44
        Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 44
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 44

    Case "SC"

        Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 42
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 42
        Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 42
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 42

    Case Else

        Target.Offset(-1, 0).Interior.ColorIndex = xlNone 'No Fill
        Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = xlNone

End Select

End Sub

However, if the contents of the merged cell (B2:C2) are deleted, I receive an error (Run-time error '13': Type Mistmatch) on the line 'Case "S" '. I can get around it with an 'On Error GoTo' line, but it means that the cell that has been conditionally formatted doesn't get returned to 'no fill'. This isn't an issue if it's done on cells that aren't merged, so it could be that I need to stop using merged cells all together - however, for user friendliness it'd be nice to keep it (rather than making the user input 'H' twice in B2 and C2 for example). For reference, this is for Excel 2003. I should add that the macro is added to a worksheet by viewing the code for that worksheet and is based on worksheet_change.

If anyone could assist on this it'd be much appreciated!

Edit: Answer below based on @Philip A Barnes' answer.

  Private Sub Worksheet_Change(ByVal Target As Range)


  Select Case Target.Columns(1).Value

  Case Empty

    Target.Columns(1).MergeArea.Offset(-1, 0).Interior.ColorIndex = xlNone 'No Fill
    Target.Columns(1).MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = xlNone

Case "S"

    Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 53
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 53
    Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 53
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 53

Case "H"

    Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 50
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 50
    Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 50
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 50

Case "T"

    Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 44
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 44
    Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 44
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 44

Case "SC"

    Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 42
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 42
    Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 42
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 42

Case Else

    Target.Offset(-1, 0).Interior.ColorIndex = xlNone 'No Fill
    Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = xlNone

End Select

End Sub

Solution

  • this is because when you have no data in the cell the Target reference returns "Empty". You need to extend your case statement to check for this:

    Private Sub Worksheet_Change(ByVal Target As Range)
    
    
    Select Case Target.Columns(1).Value
    
        Case Empty
    
            Target.Offset(-1, 0).Interior.ColorIndex = xlNone 'No Fill
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = xlNone
    
        Case "S"
    
            Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 53
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 53
            Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 53
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 53
    
        Case "H"
    
            Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 50
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 50
            Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 50
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 50
    
        Case "T"
    
            Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 44
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 44
            Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 44
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 44
    
        Case "SC"
    
            Target.MergeArea.Offset(-1, 0).Interior.ColorIndex = 42
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = 42
            Target.MergeArea.Offset(-1, 0).Font.ColorIndex = 42
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Font.ColorIndex = 42
    
        Case Else
    
            Target.Offset(-1, 0).Interior.ColorIndex = xlNone 'No Fill
            Target.MergeArea.Offset(-1, 1).Offset(0, -1).Interior.ColorIndex = xlNone
    
    End Select
    
    End Sub
    

    Make sure it is the first check you do. Also I would suggest looking into Excels built in Conditional Formatting which you can manipulate using VBA.