Format cells with a formula (7 conditions).

D

danindenver

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?
 
S

sgm020

Put these Codes in sheet module and you can change colors as yo
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 Su
 
B

Bob Phillips

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)
 
D

Dave Peterson

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.
 
Top