Format cells with a formula (7 conditions).

I want to format groups of cells with a different color according to the day
of the week specified in one of the cells. Conditional formatting allows only
4 different conditions. Is there a way to use a formula to set the cell color?

Put these Codes in sheet module and you can change colors as you
desire.

Option Explicit

Private Const xlCIBlack As Long = 1
Private Const xlCIWhite As Long = 2
Private Const xlCIRed As Long = 3
Private Const xlCIBrightGreen As Long = 4
Private Const xlCIBlue As Long = 5
Private Const xlCIYellow As Long = 6
Private Const xlCIPink As Long = 7
Private Const xlCITurquoise As Long = 8
Private Const xlCIDarkRed As Long = 9
Private Const xlCIGreen As Long = 10
Private Const xlCIDarkBlue As Long = 11
Private Const xlCIDarkYellow As Long = 12
Private Const xlCIViolet As Long = 13
Private Const xlCITeal As Long = 14
Private Const xlCIGray25 As Long = 15
Private Const xlCIGray40 As Long = 16
Private Const xlCIPaleBlue As Long = 17
Private Const xlCIPlum As Long = 18
Private Const xlCILightTurquoise As Long = 20
Private Const xlCILightBlue As Long = 23
Private Const xlCIBrown As Long = 30
Private Const xlCISkyBlue As Long = 33
Private Const xlCILightGreen As Long = 35
Private Const xlCILightYellow As Long = 36
Private Const xlCILavender As Long = 39
Private Const xlCIAqua As Long = 42
Private Const xlCILime As Long = 43
Private Const xlCIGold As Long = 44
Private Const xlCILightOrange As Long = 45
Private Const xlCIOrange As Long = 46

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Dim rng As Range
Set rng = Application.Intersect(Target,
ActiveSheet.Range("a1:IV65000"))

If Not rng Is Nothing And Target = "Monday" Then
Target.Interior.ColorIndex = 3
Exit Sub
End If

If Not rng Is Nothing And Target = "Tuesday" Then
Target.Interior.ColorIndex = 4
Exit Sub
End If

If Not rng Is Nothing And Target = "Wednesday" Then
Target.Interior.ColorIndex = 5
Exit Sub
End If

If Not rng Is Nothing And Target = "Thursday" Then
Target.Interior.ColorIndex = 7
Exit Sub
End If
If Not rng Is Nothing And Target = "Friday" Then
Target.Interior.ColorIndex = 6
Exit Sub
End If
If Not rng Is Nothing And Target = "Saturday" Then
Target.Interior.ColorIndex = 8
Exit Sub
End If
If Not rng Is Nothing And Target = "Sunday" Then
Target.Interior.ColorIndex = 13
Exit Sub
End If




ws_exit:
Application.EnableEvents = True
End Sub


--
sgm020
------------------------------------------------------------------------
sgm020's Profile: http://www.excelforum.com/member.php...o&userid=26226
View this thread: http://www.excelforum.com/showthread...hreadid=497314

If you are going to declare colour constants, you might as well use them G

Option Explicit

Private Const xlCIBlack As Long = 1
Private Const xlCIWhite As Long = 2
Private Const xlCIRed As Long = 3
Private Const xlCIBrightGreen As Long = 4
Private Const xlCIBlue As Long = 5
Private Const xlCIYellow As Long = 6
Private Const xlCIPink As Long = 7
Private Const xlCITurquoise As Long = 8
Private Const xlCIDarkRed As Long = 9
Private Const xlCIGreen As Long = 10
Private Const xlCIDarkBlue As Long = 11
Private Const xlCIDarkYellow As Long = 12
Private Const xlCIViolet As Long = 13
Private Const xlCITeal As Long = 14
Private Const xlCIGray25 As Long = 15
Private Const xlCIGray40 As Long = 16
Private Const xlCIPaleBlue As Long = 17
Private Const xlCIPlum As Long = 18
Private Const xlCILightTurquoise As Long = 20
Private Const xlCILightBlue As Long = 23
Private Const xlCIBrown As Long = 30
Private Const xlCISkyBlue As Long = 33
Private Const xlCILightGreen As Long = 35
Private Const xlCILightYellow As Long = 36
Private Const xlCILavender As Long = 39
Private Const xlCIAqua As Long = 42
Private Const xlCILime As Long = 43
Private Const xlCIGold As Long = 44
Private Const xlCILightOrange As Long = 45
Private Const xlCIOrange As Long = 46

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:

If Not rng Is Nothing And Target = "Monday" Then
Target.Interior.ColorIndex = xlCIRed
ElseIf Not rng Is Nothing And Target = "Tuesday" Then
Target.Interior.ColorIndex = xlCIBrightGreen
ElseIf Not rng Is Nothing And Target = "Wednesday" Then
Target.Interior.ColorIndex = xlCIBlue
ElseIf Not rng Is Nothing And Target = "Thursday" Then
Target.Interior.ColorIndex = xlCIPink
ElseIf Not rng Is Nothing And Target = "Friday" Then
Target.Interior.ColorIndex = xlCIYellow
ElseIf Not rng Is Nothing And Target = "Saturday" Then
Target.Interior.ColorIndex = xlCITurquoise
ElseIf Not rng Is Nothing And Target = "Sunday" Then
Target.Interior.ColorIndex = xlCIViolet
End If

ws_exit:
Application.EnableEvents = True
End Sub

--

HTH

RP
(remove nothere from the email address if mailing direct)


"sgm020" wrote in
message ...

Put these Codes in sheet module and you can change colors as you
desire.

Option Explicit

Private Const xlCIBlack As Long = 1
Private Const xlCIWhite As Long = 2
Private Const xlCIRed As Long = 3
Private Const xlCIBrightGreen As Long = 4
Private Const xlCIBlue As Long = 5
Private Const xlCIYellow As Long = 6
Private Const xlCIPink As Long = 7
Private Const xlCITurquoise As Long = 8
Private Const xlCIDarkRed As Long = 9
Private Const xlCIGreen As Long = 10
Private Const xlCIDarkBlue As Long = 11
Private Const xlCIDarkYellow As Long = 12
Private Const xlCIViolet As Long = 13
Private Const xlCITeal As Long = 14
Private Const xlCIGray25 As Long = 15
Private Const xlCIGray40 As Long = 16
Private Const xlCIPaleBlue As Long = 17
Private Const xlCIPlum As Long = 18
Private Const xlCILightTurquoise As Long = 20
Private Const xlCILightBlue As Long = 23
Private Const xlCIBrown As Long = 30
Private Const xlCISkyBlue As Long = 33
Private Const xlCILightGreen As Long = 35
Private Const xlCILightYellow As Long = 36
Private Const xlCILavender As Long = 39
Private Const xlCIAqua As Long = 42
Private Const xlCILime As Long = 43
Private Const xlCIGold As Long = 44
Private Const xlCILightOrange As Long = 45
Private Const xlCIOrange As Long = 46

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Dim rng As Range
Set rng = Application.Intersect(Target,
ActiveSheet.Range("a1:IV65000"))

If Not rng Is Nothing And Target = "Monday" Then
Target.Interior.ColorIndex = 3
Exit Sub
End If

If Not rng Is Nothing And Target = "Tuesday" Then
Target.Interior.ColorIndex = 4
Exit Sub
End If

If Not rng Is Nothing And Target = "Wednesday" Then
Target.Interior.ColorIndex = 5
Exit Sub
End If

If Not rng Is Nothing And Target = "Thursday" Then
Target.Interior.ColorIndex = 7
Exit Sub
End If
If Not rng Is Nothing And Target = "Friday" Then
Target.Interior.ColorIndex = 6
Exit Sub
End If
If Not rng Is Nothing And Target = "Saturday" Then
Target.Interior.ColorIndex = 8
Exit Sub
End If
If Not rng Is Nothing And Target = "Sunday" Then
Target.Interior.ColorIndex = 13
Exit Sub
End If




ws_exit:
Application.EnableEvents = True
End Sub


--
sgm020
------------------------------------------------------------------------
sgm020's Profile:
http://www.excelforum.com/member.php...o&userid=26226
View this thread: http://www.excelforum.com/showthread...hreadid=497314

And sometimes, if you use "Select Case" instead of If/then/else(if), you may
find the code easier to read/update later:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range

If Target.Cells.Count 1 Then Exit Sub

On Error GoTo ws_exit:

Set rng = Application.Intersect(Target, Me.Range("a:a"))
If rng Is Nothing Then Exit Sub

With Target
Select Case LCase(.Value)
Case Is = "monday": .Interior.ColorIndex = 3
Case Is = "tuesday": .Interior.ColorIndex = 4
Case Is = "wednesday": .Interior.ColorIndex = 5
Case Is = "thursday": .Interior.ColorIndex = 7
Case Is = "friday": .Interior.ColorIndex = 6
Case Is = "saturday": .Interior.ColorIndex = 8
Case Is = "sunday": .Interior.ColorIndex = 13
Case Else
.Interior.ColorIndex = xlNone
End Select
End With

ws_exit:

End Sub

And I'd stay away from constant names that start with "xl". They look too much
like the built in excel constants. And even though it doesn't confuse
excel/vba, it may confuse me.



sgm020 wrote:

Put these Codes in sheet module and you can change colors as you
desire.

Option Explicit

Private Const xlCIBlack As Long = 1
Private Const xlCIWhite As Long = 2
Private Const xlCIRed As Long = 3
Private Const xlCIBrightGreen As Long = 4
Private Const xlCIBlue As Long = 5
Private Const xlCIYellow As Long = 6
Private Const xlCIPink As Long = 7
Private Const xlCITurquoise As Long = 8
Private Const xlCIDarkRed As Long = 9
Private Const xlCIGreen As Long = 10
Private Const xlCIDarkBlue As Long = 11
Private Const xlCIDarkYellow As Long = 12
Private Const xlCIViolet As Long = 13
Private Const xlCITeal As Long = 14
Private Const xlCIGray25 As Long = 15
Private Const xlCIGray40 As Long = 16
Private Const xlCIPaleBlue As Long = 17
Private Const xlCIPlum As Long = 18
Private Const xlCILightTurquoise As Long = 20
Private Const xlCILightBlue As Long = 23
Private Const xlCIBrown As Long = 30
Private Const xlCISkyBlue As Long = 33
Private Const xlCILightGreen As Long = 35
Private Const xlCILightYellow As Long = 36
Private Const xlCILavender As Long = 39
Private Const xlCIAqua As Long = 42
Private Const xlCILime As Long = 43
Private Const xlCIGold As Long = 44
Private Const xlCILightOrange As Long = 45
Private Const xlCIOrange As Long = 46

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo ws_exit:
Dim rng As Range
Set rng = Application.Intersect(Target,
ActiveSheet.Range("a1:IV65000"))

If Not rng Is Nothing And Target = "Monday" Then
Target.Interior.ColorIndex = 3
Exit Sub
End If

If Not rng Is Nothing And Target = "Tuesday" Then
Target.Interior.ColorIndex = 4
Exit Sub
End If

If Not rng Is Nothing And Target = "Wednesday" Then
Target.Interior.ColorIndex = 5
Exit Sub
End If

If Not rng Is Nothing And Target = "Thursday" Then
Target.Interior.ColorIndex = 7
Exit Sub
End If
If Not rng Is Nothing And Target = "Friday" Then
Target.Interior.ColorIndex = 6
Exit Sub
End If
If Not rng Is Nothing And Target = "Saturday" Then
Target.Interior.ColorIndex = 8
Exit Sub
End If
If Not rng Is Nothing And Target = "Sunday" Then
Target.Interior.ColorIndex = 13
Exit Sub
End If

ws_exit:
Application.EnableEvents = True
End Sub

--
sgm020
------------------------------------------------------------------------
sgm020's Profile: http://www.excelforum.com/member.php...o&userid=26226
View this thread: http://www.excelforum.com/showthread...hreadid=497314

--

Dave Peterson