Modify Code to change cell background color

[dcgrove]

Hello, I have the code below set to change the background color based on certain conditions. What I need to do is change it so that if none of the conditions are met, it does not change the color at all. As it is written now, if anything is entered in a cell that has a background already set, but does not meet these conditions, the cell turns white.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer

 On Error GoTo ErrorHandler
 
 
'change the conditions below
  Select Case Target.Value
           Case "OFF"
                icolor = 35
            Case "RTO"
                icolor = 8
            Case "vacation"
                icolor = 8
            Case "10-9 SBP"
                icolor = 38
            Case Else
        End Select

 
  Target.Interior.ColorIndex = icolor
ErrorHandler:
    On Error Resume Next
    
 

End Sub

Thanks!
Clayton Grove

[Paul]

Hi Clayton, try this code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer

If Target.Cells.Count > 1 Then Exit Sub
icolor = Target.Interior.ColorIndex
Select Case Target.Value
    Case "OFF"
        icolor = 35
    Case "RTO", "vacation"
        icolor = 8
    Case "10-9 SBP"
        icolor = 38
    Case Else
        Target.Interior.ColorIndex = icolor
End Select
Target.Interior.ColorIndex = icolor
End Sub

[dcgrove]

That worked great thanks! I don't know if this is worthy of another thread, so if it is let me know. How can I change this line to find any sting of text with "SBP" in it. I tried "*SBP*" but it did not work?

 Case "10-9 SBP"
        icolor = 38

Thanks!
Clayton Grove

[Paul]

I think if you change your code to this it will work the way you need it. Unfortunately, Case statements don't have a Like or wildcard operator so you have to force it to perform other tests (which doesn't make it much more efficient than an If/ElseIf/Else/EndIf statement).

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer

With Target
    If .Cells.Count > 1 Then Exit Sub
    icolor = .Interior.ColorIndex

    Select Case True
        Case .Value = "OFF"
            icolor = 35
        Case .Value = "RTO" Or .Value = "vacation"
            icolor = 8
        Case .Value Like "*SBP"
            icolor = 38
        Case Else
            .Interior.ColorIndex = icolor
    End Select
    .Interior.ColorIndex = icolor
End With
End Sub

[dcgrove]

You're the man!

Thanks.
Clayton