conditional formatting color

[Sandy]

Using Excel 2003, I have downloaded John Walkenbach's calender

http://spreadsheetpage.com/index.php/file/yearly_calendar_with_holidays/

and added at the bottom columns for date A55:A88 and N55:N88 and columns for
code with a drop down list with 8 different entries B55:B88 and N55:N88. I
would like to conditional format the corresponding date on the calendar with
the matching color for the code column. Based on his formula for the
holidays =NOT(ISNA(MATCH(G7,holidays,0))) (which was formatted in each cell),
how would you put in a range for 7 different codes, as holiday is already
formatted? I have created a name for the date ranges as summary.

I assume VB is needed and I had the following based on community input that
I found:

Summary Formula Is = NOT(ISNA(MATCH(A17:Y49,summary,0))) '

On Error GoTo ws_exit:
Application.EnableEvents = False
If Not Intersect(Target, Me.Range(A17:Y49)) Is Nothing Then
With Target
Select Case .Value
Case "A": .Interior.ColorIndex = 3 'red
Case "AD": .Interior.ColorIndex = 5 'blue
Case "D": .Interior.ColorIndex = 39 'purple
Case "L": .Interior.ColorIndex = 46 'orange
Case "O": .Interior.ColorIndex = 15 'grey
Case "P": .Interior.ColorIndex = 27 'yellow
Case "T": .Interior.ColorIndex = 43 'light green
Case "V": .Interior.ColorIndex = 22 'pink

End Select
End With
End If


ws_exit:
Application.EnableEvents = True
End Sub


A17:Y49 it the range of the calendar. I am new to VB. Any help would be
appreciated. Thanks in advance.

 

[Sheeloo]

Here is the code........
(Insert in a standard module... it will run on the current sheet)
Sub markDates()
Dim i, j, k, dt
'Copy this loop till the line marked with END
'and change A to N (or M?) in
'dt = Range("A" & k).Value
'and B to O (or N if changed to M above) in
'dt = Range("B" & k).Value

For k = 55 To 88
dt = Range("A" & k).Value
For i = 7 To 39
For j = 3 To 25
If Cells(i, j).Value = dt Then
Flag = 1
With Cells(i, j)
code = Range("B" & k).Value
Select Case code
Case "A": .Interior.ColorIndex = 3 'red
Case "AD": .Interior.ColorIndex = 5 'blue
Case "D": .Interior.ColorIndex = 39 'purple
Case "L": .Interior.ColorIndex = 46 'orange
Case "O": .Interior.ColorIndex = 15 'grey
Case "P": .Interior.ColorIndex = 27 'yellow
Case "T": .Interior.ColorIndex = 43 'light green
Case "V": .Interior.ColorIndex = 22 'pink
End Select
End With
Exit For
End If
Next j
If Flag = 1 Then
Flag = 0
Exit For
End If
Next i
Next k
'END
End Sub

 

[Sheeloo]

I have added another loop so you don't have to copy....
'If your values are in M and N then change N to M and O to N in the code below
-------------------------------------
Sub markDates()
Dim i, j, k, l, dt
Dim rng(2, 2) As String
rng(1, 1) = "A"
rng(1, 2) = "B"
'If your values are in M and N then change N to M and O to N below
rng(2, 1) = "N"
rng(2, 2) = "O"

For l = 1 To 2
For k = 55 To 88
dt = Range(rng(l, 1) & k).Value
For i = 7 To 39
For j = 3 To 25
If Cells(i, j).Value = dt Then
Flag = 1
With Cells(i, j)
code = Range(rng(l, 2) & k).Value
Select Case code
Case "A": .Interior.ColorIndex = 3 'red
Case "AD": .Interior.ColorIndex = 5 'blue
Case "D": .Interior.ColorIndex = 39 'purple
Case "L": .Interior.ColorIndex = 46 'orange
Case "O": .Interior.ColorIndex = 15 'grey
Case "P": .Interior.ColorIndex = 27 'yellow
Case "T": .Interior.ColorIndex = 43 'light green
Case "V": .Interior.ColorIndex = 22 'pink
End Select
End With
Exit For
End If
Next j
If Flag = 1 Then
Flag = 0
Exit For
End If
Next i
Next k
Next l
End Sub

 

[Sandy]

The formula worked until I deleted my date. The color stayed. When I
scrolled throught more years, the color formatting stayed on that specific
day even thought there weren't any dates. Any suggestions?

 

[Sheeloo]

Use this to clear the colors

Sub ClearCells()
For i = 7 To 39
For j = 3 To 25
Cells(i, j).Interior.ColorIndex = 0
Next j
Next i
End Sub

 

[Sandy]

My boxes in the upper left corner now clears color when macro runs. I
e-mailed a copy of my file. Hope this helps explain a little better. Thanks.

 

[Sandy]

Sorry took so long to get back to you. Worked picked up and not able to work
on this.

Everything works great. Thank you so much for your help.