The colors are the same for each area, right?

Option Explicit
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim RngInput As Range
Set RngInput = Intersect(Target, Me.Range("a1:a10,a20:a30,b15:b30,b55:b60"))

If RngInput Is Nothing Then Exit Sub
On Error GoTo endit
Application.EnableEvents = False

For Each rng In RngInput.Cells
Num = 9999
'Determine the color
Select Case rng.Value
Case Is = "Red": Num = 3
Case Is = "Green": Num = 10
Case Is = "Yellow": Num = 6
Case Is = "Blue": Num = 5
End Select
If Num = 9999 Then
'do nothing
Else
'Apply the color
rng.Interior.ColorIndex = Num
End If
Next rng
endit:
Application.EnableEvents = True
End Sub


steve wrote:

Gord Dibben posted a solution to setup more than three format conditions (see
below), but it only works for a single set of conditions. Is it possible for
the sheet code to cover two distinct sets of conditions? E.g.:

Range("a1:a10,a20:a30"))
Case Is = "": Num = 2 'white
Case Is = 0: Num = 38 'red
Case Is = 1: Num = 36 'yellow
Case Is = 2: Num = 35 'green
Case Is = 3: Num = 34 'blue

Range("b15:b30,b55:b60"))
Case Is = "": Num = 2 'white
Case Is < 90: Num = 38 'red
Case Is < 80: Num = 36 'yellow
Case Is < 70: Num = 35 'green
Case Is < 50: Num = 34 'blue

TIA.

Posted by Gord Dibben MS Excel MVP 2/6/2007 9:29 AM PST

Option Compare Text
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
On Error GoTo endit
Application.EnableEvents = False
For Each rng In vRngInput
'Determine the color
Select Case rng.Value
Case Is = "Red": Num = 3
Case Is = "Green": Num = 10
Case Is = "Yellow": Num = 6
Case Is = "Blue": Num = 5
End Select
'Apply the color
rng.Interior.ColorIndex = Num
Next rng
endit:
Application.EnableEvents = True
End Sub

--

Dave Peterson