Fill Color

[Walt Herman]

Ok, I honestly spent a good half hour trying to find a posting which
approximated what I wanted to do and have run out of patience. Can someone
please help me?

I have a variance report with a column that evaluates the results of each
variance. There are 4 distinct values: Below, Meets, Exceeds, At Risk.

I need the fill color for each of these values to change automatically as
the evaluation changes. The rules for the fill color are:

“Below†should be RED, “At Risk†should be YELLOW, “Meets†should be GREEN,
and “Exceeds†should be BLUE.

I am sure there needs to be a case statement but really seem to be
challenged in writing the code. I appreciate any help you can provide.

Regards,

Walt

 

[Gary''s Student]

Do the cells contain formulae that display the text or just typed text??

 

[Walt Herman]

They contain a a vlookup formula that pulls the text from another sheet. Had
there been 3 values I would have used conditional formatting but the fourth
one put me over the top. At least in Excel 2003....

 

[Gary Keramidas]

you can give this a try. change the worksheet name and the column letter. you
may also want to change the shades of the colors.

Sub Var_Colors()
Dim ws As Worksheet
Dim i As Long
Dim icolor As Long
Dim lastrow As Long
Set ws = Worksheets("Sheet1")
lastrow = ws.Cells(Rows.Count, "C").End(xlUp).Row

For i = 2 To lastrow
With ws.Range("C" & lastrow)
Select Case UCase(.Value)
Case "BELOW"
icolor = 3
Case "AT RISK"
icolor = 6
Case "MEETS"
icolor = 4
Case "EXCEEDS"
icolor = 5
End Select
.Interior.ColorIndex = icolor
End With
Next
End Sub

 

[Gary''s Student]

In the worksheet code area, put the following event macro:

Private Sub Worksheet_Calculate()
Set b = Intersect(Range("B:B"), ActiveSheet.UsedRange)
For Each cel In b
v = xlNone
If cel.Value = "Below" Then
v = 3
End If
If cel.Value = "Meets" Then
v = 10
End If
If cel.Value = "Exceeds" Then
v = 5
End If
If cel.Value = "At Risk" Then
v = 6
End If
cel.Interior.ColorIndex = v
Next
End Sub


It colors column B. Adapt to suit.

REMEBER: the worksheet code area, not a standard module.

 

[Walt Herman]

I am very grateful. Thank you.

you can give this a try. change the worksheet name and the column letter. you
may also want to change the shades of the colors.

Sub Var_Colors()
Dim ws As Worksheet
Dim i As Long
Dim icolor As Long
Dim lastrow As Long
Set ws = Worksheets("Sheet1")
lastrow = ws.Cells(Rows.Count, "C").End(xlUp).Row

For i = 2 To lastrow
With ws.Range("C" & lastrow)
Select Case UCase(.Value)
Case "BELOW"
icolor = 3
Case "AT RISK"
icolor = 6
Case "MEETS"
icolor = 4
Case "EXCEEDS"
icolor = 5
End Select
.Interior.ColorIndex = icolor
End With
Next
End Sub

 

[Walt Herman]

would i paste this into a worksheet change event to effect the automatic
apsects of it? can you help? sorry....

 

[Walt Herman]

Not working, I altered the refernce to column M as shown below, but all of
the cells have no fill at all in column M. Thanks again...

Private Sub Worksheet_Calculate()
Set b = Intersect(Range("M:M"), ActiveSheet.UsedRange)
For Each cel In b
v = xlNone
If cel.Value = "Below" Then
v = 3
End If
If cel.Value = "Meets" Then
v = 10
End If
If cel.Value = "Exceeds" Then
v = 5
End If
If cel.Value = "At Risk" Then
v = 6
End If
cel.Interior.ColorIndex = v
Next
End Sub

 

[Gary Keramidas]

not sure if you have any other code or what you do to change your data, but if
you paste this on the worksheet code page, it may work for you

in the vb editor, right click the worksheet and click view code, then paste it.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim i As Long
Dim rng As Range
Dim icolor As Long
Dim lastrow As Long
Set ws = Worksheets("Sheet1")
lastrow = ws.Cells(Rows.Count, "M").End(xlUp).Row

For i = 2 To lastrow
With ws.Range("M" & i)
Select Case UCase(.Value)
Case "BELOW"
icolor = 3
Case "AT RISK"
icolor = 6
Case "MEETS"
icolor = 4
Case "EXCEEDS"
icolor = 5
Case Else
icolor = 0
End Select
.Interior.ColorIndex = icolor
End With
Next
End Sub