Lookup and match color of corresponding cell
See if this works for you:
Sub colorMe()
Dim srcRng As Range, ckRng As Range, Clr As Range
Set srcRng = ActiveSheet.Range("A33:A36")
Set ckRng = ActiveSheet.Range("A2:D2")
For Each c In ckRng
Set Clr = srcRng.Find(c.Value, LookIn:=xlValues)
If Not Clr Is Nothing Then
Select Case Clr.Value
Case "XX"
c.Offset(-1, 0).Interior.ColorIndex = 3
Case "XY"
c.Offset(-1, 0).Interior.ColorIndex = 41
Case "XZ"
c.Offset(-1, 0).Interior.ColorIndex = 46
Case "XE"
c.Offset(-1, 0).Interior.ColorIndex = 1
End Select
End If
Next
End Sub
wrote in message
...
Hello there,
I'm quite lost trying to figure out a simple solution to this. I have
simplified things to make things easier...
I have the following:
A B C D
1 (BLUE)
2 XY
The parantheses indicates the background color of the cell:
33 XX (RED)
34 XY (BLUE)
35 XZ (ORANGE)
36 XE (BLACK)
I need help in writing a program that will go through the range A2:D2
and try to match any non blank cells with the legend definitions in
rows 33:36, and make the background color of the cell above it equal
to the color that was looked up. In this example, I want the result of
the program to make cell B1 BLUE, which is the background definition
in row 33:36 for XY.
Please help me! You will make my day!
|