McQMom
asked on
Excel 2003 VBA conditional color formatting
I have a workbook that I have conditional formatting set up in. Everything is working great, but now the client wants some of the formatting to be based on the content of 2 cells instead of one.
In the attached workbook, on the 1st worksheet ("Benchmarks"),
column D needs to be colorindex38 if column C is 0(not blank),
it needs to be colorindex 40 if column C is 40,
it needs to be colorindex36 if column C is 50,
it needs to be colorindex 37 if column C is 70 or above AND.....
here's the real problem....
if column C is 60 AND column D is below 94, the cell in column D needs to be yellow
if column C is 60 AND column D is >93, the cell in column D needs to be green
*The code snippet I've attached below is the portion I currently have set up for the conditional formatting
In the attached workbook, on the 1st worksheet ("Benchmarks"),
column D needs to be colorindex38 if column C is 0(not blank),
it needs to be colorindex 40 if column C is 40,
it needs to be colorindex36 if column C is 50,
it needs to be colorindex 37 if column C is 70 or above AND.....
here's the real problem....
if column C is 60 AND column D is below 94, the cell in column D needs to be yellow
if column C is 60 AND column D is >93, the cell in column D needs to be green
*The code snippet I've attached below is the portion I currently have set up for the conditional formatting
Sub BenchmarksFormatting(rg As Range)
Dim Target As Range
Dim FillColors As Variant, v As Variant
FillColors = Array(38, 40, 36, 35, 37)
With rg.Worksheet
For Each Target In rg.Cells
If Target <> "" And IsNumeric(Target) Then
If Not Intersect(Target, .Range("C4:C41")) Is Nothing Then
v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("E4:E41")) Is Nothing Then
v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("F4:F41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("G4:G41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("H4:H41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("I4:I41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("K4:K41")) Is Nothing Then
v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("M4:M41")) Is Nothing Then
v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("N4:N41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("O4:O41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("P4:P41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("Q4:Q41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("S4:S41")) Is Nothing Then
v = Application.Match(Target, Array(0, 40, 50, 60, 70), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("U4:U41")) Is Nothing Then
v = Application.Match(Target, Array(0, 7.5, 8, 12, 17), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("V4:V41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("W4:W41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("X4:X41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
If Not Intersect(Target, .Range("Y4:Y41")) Is Nothing Then
v = Application.Match(Target, Array(0, 25, 50, 75, 90), 1)
If Not IsError(v) Then
Target.Interior.ColorIndex = FillColors(v - 1)
End If
End If
End If
Next
End With
End Sub
SWE-10-11-Benchmarks-6th.xls
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Try something like the following by coding for the change event for the worksheet in question.
Feel free to limit the range (upto max row for your work area in the sheet), so that the refresh time can reduced, in case of bulk delete/change in colm C or D.
Feel free to limit the range (upto max row for your work area in the sheet), so that the refresh time can reduced, in case of bulk delete/change in colm C or D.
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cl In Target
Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset first
If cl.Column = 3 And Cells(cl.Row, 3).Value <> "" Then
Select Case cl.Value
Case 0
Cells(cl.Row, 4).Interior.ColorIndex = 38
Case 40
Cells(cl.Row, 4).Interior.ColorIndex = 40
Case 50
Cells(cl.Row, 4).Interior.ColorIndex = 36
Case Is >= 70
Cells(cl.Row, 4).Interior.ColorIndex = 37
Case 60
If Cells(cl.Row, 4).Value <> "" Then
If Cells(cl.Row, 4).Value < 94 Then
Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
Else
Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
End If
End If
End Select
End If
If cl.Column = 4 And Cells(cl.Row, 4).Value <> "" And Cells(cl.Row, 3).Value = 60 Then
Select Case cl.Value
Case Is < 94
Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
Case Else
Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
End Select
End If
Next cl
End Sub
Why are you not using Conditional Formatting in Excel? Why the VBA code?
ASKER
I need more than 3 formats. There are 6 different colors I need and each column of data has a different set of conditions triggering the colors.
Just realized that my previous code had some bugs, fixed below:
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cl In Target
If cl.Column = 3 Then
If Not IsNumeric(cl) Or cl = "" Then
Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
Else
Select Case cl.Value
Case 0
Cells(cl.Row, 4).Interior.ColorIndex = 38
Case 40
Cells(cl.Row, 4).Interior.ColorIndex = 40
Case 50
Cells(cl.Row, 4).Interior.ColorIndex = 36
Case Is >= 70
Cells(cl.Row, 4).Interior.ColorIndex = 37
Case 60
Select Case Cells(cl.Row, 4).Value
Case Not IsNumeric(Cells(cl.Row, 4).Value)
Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
Case Is < 94
Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
Case Else
Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
End Select
Case Else
Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
End Select
End If
End If
If cl.Column = 4 And Cells(cl.Row, 3).Value = 60 Then
If Not IsNumeric(cl) Or cl = "" Then
Cells(cl.Row, 4).Interior.ColorIndex = 0 'reset
Else
Select Case cl.Value
Case Is < 94
Cells(cl.Row, 4).Interior.ColorIndex = 6 'yellow
Case Else
Cells(cl.Row, 4).Interior.ColorIndex = 10 'green
End Select
End If
End If
Next cl
End Sub
ASKER
tHanks - I'll give it a spin.
ASKER
Works perfectly! Thank you!!!!!!
ASKER
SantaBaby - thank you for your help. I plugged the code in and it didn't work. PhilAl's seemed to do the trick though. Thank you again!
I cannot see why you cannot do all this without Conditional Formatting, but I suppose the VBA code is easier to manage when there are that many combinations.
McQMom,
Just curious to know whether my fixed code did the work for you OR you already found another solution.
Thanks,
Just curious to know whether my fixed code did the work for you OR you already found another solution.
Thanks,
ASKER
I plugged in the fixed code and it didn't work unfortunately!
Phil Al - boy, I tried the Excel conditional formatting for quite a while before I went reluctantly to VBA. :)
Phil Al - boy, I tried the Excel conditional formatting for quite a while before I went reluctantly to VBA. :)
ASKER