VBA Offset Color property not Working

[gpatel_here]

Hi,

I have a code as below, the Offset Color property is not working, please suggest

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cell As Range
    If Not Intersect(Target, Range("C3:AG74")) Is Nothing Then

        Unprotect Password:="pass"
        For Each cell In Intersect(Target, Range("C3:AG74"))
        Select Case cell.Value
                Case "A" ' Absent
                    cell.Interior.Color = RGB(255, 0, 0) ' Dark Red
                    cell.Offset(1, 0).Interior.Color = RGB(255, 204, 204) 'light red
                    cell.Offset(1, 0).Locked = True
                    cell.Offset(1, 0).ClearContents
                    
                Case "a" ' Absent
                    cell = UCase(cell)
                    
                Case "p" ' Present
                    cell = UCase(cell)
                    
                Case "P" ' Present
                    cell.Interior.Color = RGB(97, 243, 63) ' Green
                    
                Case "h" ' Half Day
                    cell = UCase(cell)
                    
                Case "H" ' Half Day
                    cell.Interior.Color = RGB(255, 255, 101) ' Yellow
                    
                Case "OF" ' Holiday, Weekly Off
                    cell.Interior.Color = RGB(242, 220, 219) ' Light Red
                    cell.Offset(1, 0).Interior.Color = RGB(235, 235, 235)
                    cell.Offset(1, 0).Locked = True
                    cell.Offset(1, 0).ClearContents
                    
                Case "of" ' Holiday, Weekly Off
                    cell = UCase(cell)
                    
                Case "T" ' Tour
                    cell.Interior.Color = RGB(184, 204, 228) ' Light Blue
                    cell.Offset(1, 0).ClearContents
                    cell.Offset(1, 0).Value = "4"
                    
                Case "t" ' Tour
                    cell = UCase(cell)
                    
                Case Else
                    cell.Interior.ColorIndex = 0
                    cell.Offset(1, 0).Interior.ColorIndex = 0
                    cell.Offset(1, 0).Locked = False
            End Select
        Next cell
        'Protect Password:="pass"
    End If
    Protect Password:="pass"
End Sub

 

[Fluff]

Try removing the line in red

Case Else
[COLOR=#ff0000]cell.Interior.ColorIndex = 0[/COLOR]
cell.Offset(1, 0).Interior.ColorIndex = 0
cell.Offset(1, 0).Locked = False

Alternatively try this

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim cell As Range
        
Application.EnableEvents = False

    On Error GoTo Xit
    If Not Intersect(Target, Range("C3:AG74")) Is Nothing Then

        Unprotect Password:="pass"
        For Each cell In Intersect(Target, Range("C3:AG74"))
        Select Case cell.Value
                Case "A", "a" ' Absent
                    cell = UCase(cell)
                    cell.Interior.Color = RGB(255, 0, 0) ' Dark Red
                    cell.Offset(1, 0).Interior.Color = RGB(255, 204, 204) 'light red
                    cell.Offset(1, 0).Locked = True
                    cell.Offset(1, 0).ClearContents
                                      
                Case "p", "P" ' Present
                    cell = UCase(cell)
                    cell.Interior.Color = RGB(97, 243, 63) ' Green
                
                Case "h", "H" ' Half Day
                    cell = UCase(cell)
                    cell.Interior.Color = RGB(255, 255, 101) ' Yellow
                    
                Case "OF", "of" ' Holiday, Weekly Off
                    cell = UCase(cell)
                    cell.Interior.Color = RGB(242, 220, 219) ' Light Red
                    cell.Offset(1, 0).Interior.Color = RGB(235, 235, 235)
                    cell.Offset(1, 0).Locked = True
                    cell.Offset(1, 0).ClearContents
                    
                Case "T", "t" ' Tour
                    cell = UCase(cell)
                    cell.Interior.Color = RGB(184, 204, 228) ' Light Blue
                    cell.Offset(1, 0).ClearContents
                    cell.Offset(1, 0).Value = "4"
                    
                Case Else
                    cell.Interior.ColorIndex = 0
                    cell.Offset(1, 0).Interior.ColorIndex = 0
                    cell.Offset(1, 0).Locked = False
            End Select
        Next cell
    End If
'    Protect Password:="pass"
Xit:
Application.EnableEvents = True

End Sub

 

[gpatel_here]

Thank you Fluff

Your alternative works like a Charm.

I cannot remove
cell.Interior.ColorIndex = 0

as else the color fill will remain there in the cell if user deletes the data.

thanks for suggesting combining of two seperate cases i didn't knew that also.

 

[Fluff]

Glad to help & thanks for the feedback.
The reason you were having problems, was that if you typed A in a cell, then the cell below becomes blank, which in turn triggers the event macro & as the cell is blank it runs the case Else statement. Hope that is clear.