software

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(quot;a1:IV65000quot;))

If Not rng Is Nothing And Target = quot;Mondayquot; Then
Target.Interior.ColorIndex = 3
Exit Sub
End If

If Not rng Is Nothing And Target = quot;Tuesdayquot; Then
Target.Interior.ColorIndex = 4
Exit Sub
End If

If Not rng Is Nothing And Target = quot;Wednesdayquot; Then
Target.Interior.ColorIndex = 5
Exit Sub
End If

If Not rng Is Nothing And Target = quot;Thursdayquot; Then
Target.Interior.ColorIndex = 7
Exit Sub
End If
If Not rng Is Nothing And Target = quot;Fridayquot; Then
Target.Interior.ColorIndex = 6
Exit Sub
End If
If Not rng Is Nothing And Target = quot;Saturdayquot; Then
Target.Interior.ColorIndex = 8
Exit Sub
End If
If Not rng Is Nothing And Target = quot;Sundayquot; Then
Target.Interior.ColorIndex = 13
Exit Sub
End If

ws_exit:
Application.EnableEvents = True
End Sub--
sgm020
------------------------------------------------------------------------
sgm020's Profile: www.excelforum.com/member.php...oamp;userid=26226
View this thread: www.excelforum.com/showthread...hreadid=497314If you are going to declare colour constants, you might as well use them lt;Ggt;

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 = quot;Mondayquot; Then
Target.Interior.ColorIndex = xlCIRed
ElseIf Not rng Is Nothing And Target = quot;Tuesdayquot; Then
Target.Interior.ColorIndex = xlCIBrightGreen
ElseIf Not rng Is Nothing And Target = quot;Wednesdayquot; Then
Target.Interior.ColorIndex = xlCIBlue
ElseIf Not rng Is Nothing And Target = quot;Thursdayquot; Then
Target.Interior.ColorIndex = xlCIPink
ElseIf Not rng Is Nothing And Target = quot;Fridayquot; Then
Target.Interior.ColorIndex = xlCIYellow
ElseIf Not rng Is Nothing And Target = quot;Saturdayquot; Then
Target.Interior.ColorIndex = xlCITurquoise
ElseIf Not rng Is Nothing And Target = quot;Sundayquot; 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)quot;sgm020quot; gt; wrote in
message ...
gt;
gt; Put these Codes in sheet module and you can change colors as you
gt; desire.
gt;
gt; Option Explicit
gt;
gt; Private Const xlCIBlack As Long = 1
gt; Private Const xlCIWhite As Long = 2
gt; Private Const xlCIRed As Long = 3
gt; Private Const xlCIBrightGreen As Long = 4
gt; Private Const xlCIBlue As Long = 5
gt; Private Const xlCIYellow As Long = 6
gt; Private Const xlCIPink As Long = 7
gt; Private Const xlCITurquoise As Long = 8
gt; Private Const xlCIDarkRed As Long = 9
gt; Private Const xlCIGreen As Long = 10
gt; Private Const xlCIDarkBlue As Long = 11
gt; Private Const xlCIDarkYellow As Long = 12
gt; Private Const xlCIViolet As Long = 13
gt; Private Const xlCITeal As Long = 14
gt; Private Const xlCIGray25 As Long = 15
gt; Private Const xlCIGray40 As Long = 16
gt; Private Const xlCIPaleBlue As Long = 17
gt; Private Const xlCIPlum As Long = 18
gt; Private Const xlCILightTurquoise As Long = 20
gt; Private Const xlCILightBlue As Long = 23
gt; Private Const xlCIBrown As Long = 30
gt; Private Const xlCISkyBlue As Long = 33
gt; Private Const xlCILightGreen As Long = 35
gt; Private Const xlCILightYellow As Long = 36
gt; Private Const xlCILavender As Long = 39
gt; Private Const xlCIAqua As Long = 42
gt; Private Const xlCILime As Long = 43
gt; Private Const xlCIGold As Long = 44
gt; Private Const xlCILightOrange As Long = 45
gt; Private Const xlCIOrange As Long = 46
gt;
gt; Private Sub Worksheet_Change(ByVal Target As Range)
gt;
gt; On Error GoTo ws_exit:
gt; Dim rng As Range
gt; Set rng = Application.Intersect(Target,
gt; ActiveSheet.Range(quot;a1:IV65000quot;))
gt;
gt; If Not rng Is Nothing And Target = quot;Mondayquot; Then
gt; Target.Interior.ColorIndex = 3
gt; Exit Sub
gt; End If
gt;
gt; If Not rng Is Nothing And Target = quot;Tuesdayquot; Then
gt; Target.Interior.ColorIndex = 4
gt; Exit Sub
gt; End If
gt;
gt; If Not rng Is Nothing And Target = quot;Wednesdayquot; Then
gt; Target.Interior.ColorIndex = 5
gt; Exit Sub
gt; End If
gt;
gt; If Not rng Is Nothing And Target = quot;Thursdayquot; Then
gt; Target.Interior.ColorIndex = 7
gt; Exit Sub
gt; End If
gt; If Not rng Is Nothing And Target = quot;Fridayquot; Then
gt; Target.Interior.ColorIndex = 6
gt; Exit Sub
gt; End If
gt; If Not rng Is Nothing And Target = quot;Saturdayquot; Then
gt; Target.Interior.ColorIndex = 8
gt; Exit Sub
gt; End If
gt; If Not rng Is Nothing And Target = quot;Sundayquot; Then
gt; Target.Interior.ColorIndex = 13
gt; Exit Sub
gt; End If
gt;
gt;
gt;
gt;
gt; ws_exit:
gt; Application.EnableEvents = True
gt; End Sub
gt;
gt;
gt; --
gt; sgm020
gt; ------------------------------------------------------------------------
gt; sgm020's Profile:
www.excelforum.com/member.php...oamp;userid=26226
gt; View this thread: www.excelforum.com/showthread...hreadid=497314
gt;
And sometimes, if you use quot;Select Casequot; 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 gt; 1 Then Exit Sub

On Error GoTo ws_exit:

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

With Target
Select Case LCase(.Value)
Case Is = quot;mondayquot;: .Interior.ColorIndex = 3
Case Is = quot;tuesdayquot;: .Interior.ColorIndex = 4
Case Is = quot;wednesdayquot;: .Interior.ColorIndex = 5
Case Is = quot;thursdayquot;: .Interior.ColorIndex = 7
Case Is = quot;fridayquot;: .Interior.ColorIndex = 6
Case Is = quot;saturdayquot;: .Interior.ColorIndex = 8
Case Is = quot;sundayquot;: .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 quot;xlquot;. 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:
gt;
gt; Put these Codes in sheet module and you can change colors as you
gt; desire.
gt;
gt; Option Explicit
gt;
gt; Private Const xlCIBlack As Long = 1
gt; Private Const xlCIWhite As Long = 2
gt; Private Const xlCIRed As Long = 3
gt; Private Const xlCIBrightGreen As Long = 4
gt; Private Const xlCIBlue As Long = 5
gt; Private Const xlCIYellow As Long = 6
gt; Private Const xlCIPink As Long = 7
gt; Private Const xlCITurquoise As Long = 8
gt; Private Const xlCIDarkRed As Long = 9
gt; Private Const xlCIGreen As Long = 10
gt; Private Const xlCIDarkBlue As Long = 11
gt; Private Const xlCIDarkYellow As Long = 12
gt; Private Const xlCIViolet As Long = 13
gt; Private Const xlCITeal As Long = 14
gt; Private Const xlCIGray25 As Long = 15
gt; Private Const xlCIGray40 As Long = 16
gt; Private Const xlCIPaleBlue As Long = 17
gt; Private Const xlCIPlum As Long = 18
gt; Private Const xlCILightTurquoise As Long = 20
gt; Private Const xlCILightBlue As Long = 23
gt; Private Const xlCIBrown As Long = 30
gt; Private Const xlCISkyBlue As Long = 33
gt; Private Const xlCILightGreen As Long = 35
gt; Private Const xlCILightYellow As Long = 36
gt; Private Const xlCILavender As Long = 39
gt; Private Const xlCIAqua As Long = 42
gt; Private Const xlCILime As Long = 43
gt; Private Const xlCIGold As Long = 44
gt; Private Const xlCILightOrange As Long = 45
gt; Private Const xlCIOrange As Long = 46
gt;
gt; Private Sub Worksheet_Change(ByVal Target As Range)
gt;
gt; On Error GoTo ws_exit:
gt; Dim rng As Range
gt; Set rng = Application.Intersect(Target,
gt; ActiveSheet.Range(quot;a1:IV65000quot;))
gt;
gt; If Not rng Is Nothing And Target = quot;Mondayquot; Then
gt; Target.Interior.ColorIndex = 3
gt; Exit Sub
gt; End If
gt;
gt; If Not rng Is Nothing And Target = quot;Tuesdayquot; Then
gt; Target.Interior.ColorIndex = 4
gt; Exit Sub
gt; End If
gt;
gt; If Not rng Is Nothing And Target = quot;Wednesdayquot; Then
gt; Target.Interior.ColorIndex = 5
gt; Exit Sub
gt; End If
gt;
gt; If Not rng Is Nothing And Target = quot;Thursdayquot; Then
gt; Target.Interior.ColorIndex = 7
gt; Exit Sub
gt; End If
gt; If Not rng Is Nothing And Target = quot;Fridayquot; Then
gt; Target.Interior.ColorIndex = 6
gt; Exit Sub
gt; End If
gt; If Not rng Is Nothing And Target = quot;Saturdayquot; Then
gt; Target.Interior.ColorIndex = 8
gt; Exit Sub
gt; End If
gt; If Not rng Is Nothing And Target = quot;Sundayquot; Then
gt; Target.Interior.ColorIndex = 13
gt; Exit Sub
gt; End If
gt;
gt; ws_exit:
gt; Application.EnableEvents = True
gt; End Sub
gt;
gt; --
gt; sgm020
gt; ------------------------------------------------------------------------
gt; sgm020's Profile: www.excelforum.com/member.php...oamp;userid=26226
gt; View this thread: www.excelforum.com/showthread...hreadid=497314

--

Dave Peterson