Loop/Conditional formatting 3 cells above - More than 3 conditions

G

Guest

I have the following code which changes the color of the cell based on its
value.
Now I need to color not only that particular cell, but also 3 cells above
it. How can I put it in a loop.

This is my code.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A1:AQ120")) Is Nothing Then
Select Case Target

Case Is = "A"
icolor = 38
Case Is = "B"
icolor = 38
Case Is = "C"
icolor = 35
Case Is = "D"
icolor = 36
Case Is = "E"
icolor = 39
Case Is = "F"
icolor = 35
Case Is = "G"
icolor = 37
Case Is = "H"
icolor = 34
Case Is = "I"
icolor = 40
Case Is = "J"
icolor = 40
Case Is = "K"
icolor = 34
Case Is = "L"
icolor = 34
Case Is = "M"
icolor = 34
Case Else
'Whatever
End Select

Target.Interior.ColorIndex = icolor
End If

End Sub
 
G

Guest

Hi,

I have modified the code like this. But now the cells are becoming white,
instead of the defined colors.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim icolor As Integer


If Not Intersect(Target, Range("A1:AQ120")) Is Nothing Then
Select Case Target.Offset(-3, 0).Resize(4, 1).Interior.ColorIndex =
icolor


Case Is = "Distribution Workbench"
icolor = 38
Case Is = "Distribution CRM"
icolor = 38
Case Is = "RPP"
icolor = 35
Case Is = "Architecture"
icolor = 36
Case Is = "Business Analysts"
icolor = 39
Case Is = "CDE (RPD)"
icolor = 35
Case Is = "QA"
icolor = 37
Case Is = "PMO"
icolor = 34
Case Is = "WIRE"
icolor = 40
Case Is = "UDP"
icolor = 40
Case Is = "Mgmt"
icolor = 34
Case Is = "Unknown"
icolor = 34
Case Is = "spare Desk"
icolor = 34
Case Else
'Whatever
End Select

Target.Interior.ColorIndex = icolor
End If

End Sub
 
T

Tom Ogilvy

I have applied the change I was suggesting. You put it in the wrong place.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A1:AQ120")) Is Nothing Then
Select Case Target

Case Is = "A"
icolor = 38
Case Is = "B"
icolor = 38
Case Is = "C"
icolor = 35
Case Is = "D"
icolor = 36
Case Is = "E"
icolor = 39
Case Is = "F"
icolor = 35
Case Is = "G"
icolor = 37
Case Is = "H"
icolor = 34
Case Is = "I"
icolor = 40
Case Is = "J"
icolor = 40
Case Is = "K"
icolor = 34
Case Is = "L"
icolor = 34
Case Is = "M"
icolor = 34
Case Else
'Whatever
End Select

Target.offset(-3,0).Resize(4,1).Interior.ColorIndex = icolor
End If

End Sub
 
G

Guest

Hi Tom,

Thanks very much. I have just one more problem, the colors are not changing
or refreshing automatically. Now i go & double click on each cell to reflect
the color change. Is there an easier way to refresh or make the color change
automatically while saving...

Regards
Rajula
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top