VBA Conditional formatting with merged cells

[thebawp]

I have a spreadsheet set up like this:


A B C
1 Basic rota 09:00 13:00
2 Absence H

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 Target 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). 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).

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

Many thanks,

Kirsty

 

[thebawp]

Solution obtained from here: merge - VBA conditional formatting based on contents of merged cells - Stack Overflow

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

Thanks.