Conditional Formatting - More Than 3?

[Annabelle]

I need five conditional formats in the same worksheet. As
the Conditional Formatting feature has a 3 condition
limitation, can this be accomplished through a macro?

 

[Gord Dibben]

Annabelle

That should be "3 CF conditions per cell" not per worksheet. You can have CF
on every cell in the worksheet.

If you mean 5 in a cell then the code below is an example of VBA CF in a
worksheet. Adjust to suit.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim vRngInput As Variant
Set vRngInput = Intersect(Target, Range("A:A"))
If vRngInput Is Nothing Then Exit Sub
For Each rng In vRngInput
'Determine the color
Select Case rng.Value
Case Is <= 0: Num = 10 'green
Case 0 To 5: Num = 1 'black
Case 5 To 10: Num = 5 'blue
Case 10 To 15: Num = 7 'magenta
Case 15 To 20: Num = 46 'orange
Case Is > 20: Num = 3 'red
End Select
'Apply the color
rng.Font.ColorIndex = Num
Next rng
End Sub

Gord Dibben Excel MVP - XL97 SR2 & XL2002

 

[Gord Dibben]

Thanks for the feedback. Glad to assist.

Gord

Pefect, you are the best. Thank you for your time and help.
Annabelle

 

[rottenstock]

I was wondering if using the code listed here, if it would be possible to shade an entire range of cells depending on what the status of column A was.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim vRngInput As Variant
Set vRngInput = Intersect(Target, Range("A:L"))
If vRngInput Is Nothing Then Exit Sub
For Each rng In vRngInput
'Determine the color
Select Case rng.Value
Case Is <= " ": Num = 10 'green
Case "Closed": Num = 3 'black
Case "In Process": Num = 5 'blue
Case "Delivered": Num = 50 'magenta
Case "Pending Delivery": Num = 7 'magenta
Case "Pending Repair": Num = 46 'orange
Case Is > 20: Num = 3 'red
End Select
'Apply the color
rng.Font.ColorIndex = Num
Next rng
End Sub


I know there is the 'Cell.EntireRow.Interior.ColorIndex' command, but i cannot get it to change color of the whole range from A:L.

Anyone have any suggestions for this?

 

[grage]

Please Help Me...
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim vRngInput As Variant
Set vRngInput = Intersect(Target, Range("A:A"))
If vRngInput Is Nothing Then Exit Sub
For Each rng In vRngInput
'Determine the color
Select Case rng.Value
Case Is <= 0: Num = 10 'green
Case 0 To 5: Num = 1 'black
Case 5 To 10: Num = 5 'blue
Case 10 To 15: Num = 7 'magenta
Case 15 To 20: Num = 46 'orange
Case Is > 20: Num = 3 'red
End Select
'Apply the color
rng.Font.ColorIndex = Num
Next rng
End Sub

How but color Cell not font ?