View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default change colour on value, 4+ colors

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myColor As Long

If Target.Cells.Count 1 Then Exit Sub
If Intersect(Target, Me.Range("S:S")) Is Nothing Then Exit Sub

Select Case LCase(Target.Value)
Case Is = "1": Cells(Target.Row, "B").Interior.ColorIndex = 3
Case Is = "2": Cells(Target.Row, "B").Interior.ColorIndex = 46
Case Is = "3": Cells(Target.Row, "B").Interior.ColorIndex = 6
Case Is = "4": Cells(Target.Row, "B").Interior.ColorIndex = 4
Case Is = "5": Cells(Target.Row, "B").Interior.ColorIndex = 34
Case Else:
Cells(Target.Row, "B").Interior.ColorIndex = xlColorIndexNone
End Select

End Sub

--

HTH

RP

"nejlangton" wrote in message
...

Hi,

I have a spreadsheet with different rows of data refering to seperate
issues etc. these are ranked either 1-5 or 1-7. the rank is held in
column s, however I want the 2nd cell in the row (column b) to change
colour according to to the value in column s.

Given that there are more than 3 colours needed, i cant use normal
conditional formatting and so am trying to use the following macro. it
first targets column s and where values i then want it to target column
b in the same row and change the colour according to the value.

I would be really grateful for any help.

Cheers

Nejl

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myColor As Long

If Target.Cells.Count 1 Then Exit Sub
If Intersect(Target, Me.Range("s:s")) Is Nothing Then Exit Sub

Select Case LCase(Target.Value)
Case Is = "1": Target.Cell("b, 0").Interior.ColorIndex = 3
Case Is = "2": Target.Cell("b, 0").Interior.ColorIndex = 46
Case Is = "3": Target.Cell("b, 0").Interior.ColorIndex = 6
Case Is = "4": Target.Cell("b, 0").Interior.ColorIndex = 4
Case Is = "5": Target.Cell("b, 0").Interior.ColorIndex = 34
Case Else
myColor = xlNone
End Select

Target.Interior.ColorIndex = myColor

End Sub


--
nejlangton
------------------------------------------------------------------------
nejlangton's Profile:

http://www.excelforum.com/member.php...o&userid=13970
View this thread: http://www.excelforum.com/showthread...hreadid=264289