Select Case Conditional Formatting VBA

[Nick72310]

I am trying to simplify my conditional formatting (CF) code by using select case. However, I cannot seem to get the code to run through anything other than case "".
The reason I am trying to code the CF is because when a person copy and paste data, the CF gets all messed up.

My code is shown below. I have the CF code in a separate macro, called "CF", and it gets called in worksheet_change, which also includes auto capitalizing (that works fine).

Private Sub worksheet_change(ByVal Target As Range)
On Error Resume Next
'Default Cells and AUTOCAPS
    Dim RngToCheckForNonFormulae As Range, RngToCheckForUserInput As Range, cll As Range
    On Error GoTo GracefulExit
     'AUTO CAPS and CF
     
     With ActiveCell
        r = .Row
        c = .Column
        r = r - 1
    End With
     
    Set RngToCheckForUserInput = Intersect(Target, Range(Cells(4, 2), Cells(Rows.Count, 2)))
    If Not RngToCheckForUserInput Is Nothing Then
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            .EnableEvents = False
        End With
        For Each cll In RngToCheckForUserInput.Cells
            If Not cll.HasFormula And Len(cll.Value) > 0 Then cll.Value = UCase(cll.Value)
        Next cll
        
    Cells(r, c).Select
    '------------------ Conditional Formatting Code gets called here --------------------------
    Call CF
    '------------------------------------------------------------------------------------------
    Cells(r + 1, c).Select
        
    End If
GracefulExit:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

Sub CF()
    Selection.FormatConditions.Delete
    Dim rr, gg, bb
    
    With ActiveCell
        r = .Row
        c = .Column
        r = r - 1
    End With
    
Select Case Sheets("Hide2").Cells(r, c)
    Case False
        rr = 0
        gg = 0
        bb = 0
        GoTo Color_Code
    Case "inactive"
        rr = 0
        gg = 0
        bb = 0
        GoTo Color_Code
    Case "rfq"
        rr = 112
        gg = 48
        bb = 160
        GoTo Color_Code
    Case "phase-out"
        rr = 51
        gg = 63
        bb = 79
        GoTo Color_Code
    Case "engineer"
        rr = 0
        gg = 176
        bb = 80
        GoTo Color_Code
    Case "design"
        rr = 255
        gg = 103
        bb = 0
        GoTo Color_Code
    Case "obsolete"
        rr = 255
        gg = 51
        bb = 0
        GoTo Color_Code
    Case "prototype"
        rr = 0
        gg = 133
        bb = 192
        GoTo Color_Code
    Case ""
        Exit Sub
End Select
    
Color_Code:
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=Hide2!B" & Selection.Row & "=" & Sheets("Hide2").Cells(r, c) & ""
    '"=""inactive"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        'Black
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        
        'White
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1).Borders(xlBottom)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.FormatConditions(1)
        .Interior.Color = RGB(rr, gg, bb)
    End With
    Selection.FormatConditions(1).StopIfTrue = False
End Sub

[Bob Phillips]

Can you post the workbook?

[Nick72310]

Here it the file.

VBA Help - Thank You!.xlsm

I have another posted forum regarding this same spreadsheet (different question), so that will be all the other stuff you see in the file. Feel free to take a look at that if you wish. But at the moment, I am more concerned with the conditional formatting question.

http://www.vbaexpress.com/forum/show...-%28*%29-excel

[Bob Phillips]

Private Sub worksheet_change(ByVal Target As Range)
On Error Resume Next
'Default Cells and AUTOCAPS
    Dim RngToCheckForNonFormulae As Range, RngToCheckForUserInput As Range, cll As Range
    Dim r As Long, c As Long
    
    On Error GoTo GracefulExit
     
    If Target.Cells.Count = 1 Then
        
        Set RngToCheckForUserInput = Intersect(Target, Range(Cells(4, 2), Cells(Rows.Count, 2)))
        If Not RngToCheckForUserInput Is Nothing Then
        
            With Application
                .ScreenUpdating = False
                .Calculation = xlCalculationManual
                .EnableEvents = False
            End With
        
            r = Target.Row - 1
            c = Target.Column
            
            For Each cll In RngToCheckForUserInput.Cells
            
                If Not cll.HasFormula And Len(cll.Value) > 0 Then cll.Value = UCase(cll.Value)
            Next cll
            
            Call CF(Target)
            Cells(r + 1, c).Select
        End If
    End If
    
GracefulExit:
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
End Sub

Sub CF(ByRef Target As Range)
    Target.FormatConditions.Delete
    Dim rr, gg, bb
    
    Select Case LCase(Sheets("Hide2").Cells(Target.Row, Target.Column).Value)
        Case False
            rr = 0
            gg = 0
            bb = 0
        Case "inactive"
            rr = 0
            gg = 0
            bb = 0
        Case "rfq"
            rr = 112
            gg = 48
            bb = 160
        Case "phase-out"
            rr = 51
            gg = 63
            bb = 79
        Case "engineer"
            rr = 0
            gg = 176
            bb = 80
        Case "design"
            rr = 255
            gg = 103
            bb = 0
        Case "obsolete"
            rr = 255
            gg = 51
            bb = 0
        Case "prototype"
            rr = 0
            gg = 133
            bb = 192
        Case ""
            Exit Sub
End Select
    
Color_Code:
    With Target
    
        .FormatConditions.Add Type:=xlExpression, Formula1:="=Hide2!B" & .Row & "=""" & Sheets("Hide2").Cells(Target.Row, Target.Column) & """"
        '"=""inactive"""
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Font
        
            'Black
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            
            'White
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        
        With .FormatConditions(1).Borders(xlLeft)
        
            .LineStyle = xlContinuous
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .FormatConditions(1).Borders(xlRight)
        
            .LineStyle = xlContinuous
            .TintAndShade = 0
            .Weight = xlThin
        End With
        
        With .FormatConditions(1).Borders(xlTop)
        
            .LineStyle = xlContinuous
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With .FormatConditions(1).Borders(xlBottom)
        
            .LineStyle = xlContinuous
            .TintAndShade = 0
            .Weight = xlThin
        End With

        With .FormatConditions(1)
            .Interior.Color = RGB(rr, gg, bb)
        End With
        
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub

[Nick72310]

Works great!!! I tested all the cases. Thank you!

[Nick72310]

Actually, I have one last question. How can I also add: If it's a duplicate, RGB(255, 255, 0)? That would need to go on every condition.

[Bob Phillips]

What designates a duplicate? And does that take precedence over the other test?

[Nick72310]

It will be considered a duplicate if any of the items in the range are the same name. [Set RngToCheckForUserInput = Intersect(Target, Range(Cells(4, 2), Cells(Rows.Count, 2)))]
Yes, duplicates are at the top of the hierarchy. It needs to be known before the other rules.

[snb]

Alternative for Select Case:

y = Choose(InStr("rfphendeobpr", Left(LCase(target), 2)) \ 2 + 1, 0, RGB(112, 48, 180), RGB(51, 63, 79), RGB(0, 176, 80), RGB(255, 103, 0), RGB(255, 51, 0), RGB(0, 133, 192))