Conditional Formatting Help!

[vera.liang]

I need to apply CF macro to my 2003 since I need to have 5
conditions. I know that I can download addins but I am working from a
secure network without internet access.

The range is A1:CM190. Here are my conditions

If the cell value is 1, then the font and internior color index is 6
'yellow'
If the cell value is 2, then the font and internior color index is 46
'Orange'
If the cell value is 3, then the font and internior color index is 37
'blue'
If the cell value is 4, then the font and internior color index is 5
'Dark blue'
If the cell value is 5, then the font and internior color index is 3
'red'

Any help I can get is highly appreciated!!!

Thanks!

 

[Tom Hutchins]

Paste the following event code into the code module for the sheet where you
want this formatting to occur:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A1:CM190")) Is Nothing Then Exit Sub
Select Case Target.Value
Case 1
Target.Font.ColorIndex = 6
Target.Interior.ColorIndex = 6
Case 2
Target.Font.ColorIndex = 46
Target.Interior.ColorIndex = 46
Case 3
Target.Font.ColorIndex = 37
Target.Interior.ColorIndex = 37
Case 4
Target.Font.ColorIndex = 5
Target.Interior.ColorIndex = 5
Case 5
Target.Font.ColorIndex = 3
Target.Interior.ColorIndex = 3
Case Else
Target.Font.ColorIndex = xlColorIndexAutomatic
Target.Interior.ColorIndex = xlColorIndexAutomatic
End Select
End Sub

By setting the font colorindex and the interior colorindex to the same
value, you can't see what is entered in the cell. Is that what you intended?

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Hope this helps,

Hutch

 

[Peter T]

Another one, in the worksheet module -

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Dim cIdx As Long, fIdx As Long

On Error GoTo errExit
Set rng = Intersect(Range("A1:CM190"), Target)
If Not rng Is Nothing Then
For Each cell In rng
With cell
Select Case .Value
Case 1: cIdx = 6
Case 2: cIdx = 46
Case 3: cIdx = 37
Case 4: cIdx = 5
Case 5: cIdx = 3
Case Else: cIdx = xlNone
End Select

If cIdx = xlNone Then
fIdx = xlAutomatic
Else
fIdx = cIdx
End If

With .Interior
If .ColorIndex <> cIdx Then .ColorIndex = cIdx
End With

With .Font
If .ColorIndex <> fIdx Then .ColorIndex = fIdx
End With
End With
Next
End If
Exit Sub
errExit:
End Sub

Regards,
Peter T