Nick72310
04-18-2016, 12:31 PM
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).SetFirstPriori ty
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
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).SetFirstPriori ty
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