Conditional Formating in Calendar

Douglas Edward

New Member
Joined
Jul 24, 2018
Messages
22
Office Version
  1. 2019
Platform
  1. Windows
I want to highlight the days on my calendar that match my Event list, but I want the different events to have different colors.

example:
Event List
1. 1/3/2020 - Baseball
2. 1/4/2020 - Football
3. 1/5/2020 - Golf
4. 1/6/2020 - Baseball
5. 1/7/2020 - Baseball
6. 1/8/2020 - Golf

I want the Baseball days to have a Blue fill color, Golf days to have a green fill color, and Football to have a red fill color. (on the calendar)

Is this possible?
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
try this

<img src="https://www.pixelsbin.com/images/2019/06/21/1c59442f17341e689.jpg" alt="1c59442f17341e689.jpg" border="0">
<img src="https://www.pixelsbin.com/images/2019/06/21/2525f65441d873889.jpg" alt="2525f65441d873889.jpg" border="0">
 
Upvote 0
Thanks for your reply Alan. Sorry, I didn't make my question clear. Here is the result I am looking for:

BCDEFGHIJKLMNOPQRSTUVWXYZAAAB
3JanuaryFebruary
MarchDate Event
4SMTWTFSSMTWTFSSMTWTFS1/3/2020Baseball
51234112345671/4/2020Football
656789101123456788910111213141/5/2020Golf
7121314151617189101112131415151617181920211/6/2020Baseball
81920212223242516171819202122222324252627281/7/2020Baseball
9262728293031232425262728292930311/8/2020Golf
10

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet1
I can make them all one color if I use a match formula, but I want each event a different color.
 
Upvote 0
Hmmm? The colors didn't go through. I wonder what I did wrong. I'm a newbie.

The colors should be on the calendar dates, not the event list.
 
Upvote 0

Book1
BCDEFGHIJKLMNOPQRSTUVWXYZAAAB
3JanuaryFeburaryMarchDateEvent
4SMTWTFSSMTWTFSSMTWTFS1/3/2020Baseball
51234112345671/4/2020Football
656789101123456788910111213141/5/2020Golf
7121314151617189101112131415151617181920211/6/2020Baseball
81920212223242516171819202122222324252627281/7/2020Baseball
9262728293031232425262728292930311/8/2020Golf
10
Sheet1
Cell Formulas
RangeFormula
F5=E5+1
F6=E6+1
F7=E7+1
F8=E8+1
F9=E9+1
G5=F5+1
G6=F6+1
G7=F7+1
G8=F8+1
G9=F9+1
H5=G5+1
H6=G6+1
H7=G7+1
H8=G8+1
S5=R5+1
S6=R6+1
S7=R7+1
S8=R8+1
S9=R9+1
T5=S5+1
T6=S6+1
T7=S7+1
T8=S8+1
T9=S9+1
U5=T5+1
U6=T6+1
U7=T7+1
U8=T8+1
V5=U5+1
V6=U6+1
V7=U7+1
V8=U8+1
W5=V5+1
W6=V6+1
W7=V7+1
W8=V8+1
X5=W5+1
X6=W6+1
X7=W7+1
X8=W8+1
B6=H5+1
B7=H6+1
B8=H7+1
B9=H8+1
C6=B6+1
C7=B7+1
C8=B8+1
C9=B9+1
D6=C6+1
D7=C7+1
D8=C8+1
D9=C9+1
E6=D6+1
E7=D7+1
E8=D8+1
E9=D9+1
J6=P5+1
J7=P6+1
J8=P7+1
J9=P8+1
K6=J6+1
K7=J7+1
K8=J8+1
K9=J9+1
L6=K6+1
L7=K7+1
L8=K8+1
L9=K9+1
M6=L6+1
M7=L7+1
M8=L8+1
M9=L9+1
N6=M6+1
N7=M7+1
N8=M8+1
N9=M9+1
O6=N6+1
O7=N7+1
O8=N8+1
O9=N9+1
P6=O6+1
P7=O7+1
P8=O8+1
P9=O9+1
R6=X5+1
R7=X6+1
R8=X7+1
R9=X8+1
 
Upvote 0
Douglas Edward,
Based on your post the following code should do what you have requested.
Enter the code in a standard module. Open the Visual Basic Editor (Alt+F11), then copy and paste into the window that opens. Close the window and save the file as macro enabled.
You may have to enable macros when you reopen the file depending on the version of Excel you are running.
The code is set to run on months 'January', 'February', and 'March'. You will have to modify the code if you add the remaining months depending on where you place them.
To run the code press Alt+F8 and then select 'MySports', then select 'Run'.
Hope this helps.
Perpa
Code:
Sub MySports()
Dim LR, rw1, rw2, col As Long
Dim myDay
Dim myMonth As String


With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With


LR = Range("AB4").End(xlDown).Row


For rw1 = 4 To LR
    myDay = Day(Cells(rw1, "AB"))
    myMonth = Application.Text(Cells(rw1, "AB"), "mmmm")
    
        If myMonth = "January" Then
            For rw2 = 5 To 9
                For col = 3 To 9
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Baseball" Then Cells(rw2, col).Interior.ColorIndex = 33 'Blue
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Football" Then Cells(rw2, col).Interior.ColorIndex = 10  'Green
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Golf" Then Cells(rw2, col).Interior.ColorIndex = 3  'Red
                Next
            Next
        End If
        
        If myMonth = "February" Then
            For rw2 = 5 To 9
                For col = 11 To 17
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Baseball" Then Cells(rw2, col).Interior.ColorIndex = 33 'Blue
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Football" Then Cells(rw2, col).Interior.ColorIndex = 10 'Green
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Golf" Then Cells(rw2, col).Interior.ColorIndex = 3  'Red
                Next
            Next
        End If
        
        If myMonth = "March" Then
            For rw2 = 5 To 9
                For col = 13 To 24
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Baseball" Then Cells(rw2, col).Interior.ColorIndex = 33  'Blue
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Football" Then Cells(rw2, col).Interior.ColorIndex = 10  'Green
                    If myDay = Cells(rw2, col) And Cells(rw1, "AC") = "Golf" Then Cells(rw2, col).Interior.ColorIndex = 3  'Red
                Next
            Next
        End If
Next


With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub
 
Upvote 0
Recently, I set up a tutorial for a dynamic calendar in multiple languages on the Internet. See if she can help you. You have an example to download there. Also, there is a list of events and highlighting the date in the calendar.
btw: Too much I should be putting everything here

Setting Conditional Formatting for Certain Events
How to highlight vacation dates in a dynamic calendar
Code:
Conditional Formatting formula for highlighting a day that does not belong to a particular month is below (gray cells)
=MONTH(C7)<>MONTH($C$4)
Conditional Formatting formula for highlighting today's day (red cell)
=C7=TODAY()
Conditional Formatting formula for highlighting a day if there are certain events in a month (green cells)
=MATCH(C7;events;0)

highlight-vacation-date-in-dynamic-calendar.png


excel-dynamic-calendar.png
 
Last edited:
Upvote 0
My 2 cents worth:
Code:
Sub ColourDates()
    Application.ScreenUpdating = False
    Dim LastRow As Long, rDate As Range, lCol As Long, fil As Long, fnd As Range
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rDate In Range("AA4:AA" & LastRow)
        If Month(rDate) = 1 Then
            lCol = Rows(3).Find("January", LookIn:=xlValues, lookat:=xlWhole).Column
            Select Case rDate.Offset(0, 1).Value
                Case "Baseball": fil = 37
                Case "Football": fil = 4
                Case "Golf": fil = 3
            End Select
            Set fnd = Cells(5, lCol).Resize(5, 7).Find(Day(rDate), LookIn:=xlValues, lookat:=xlWhole)
            fnd.Interior.ColorIndex = fil
        ElseIf Month(rDate) = 2 Then
            lCol = Rows(3).Find("February", LookIn:=xlValues, lookat:=xlWhole).Column
            Select Case rDate.Offset(0, 1).Value
                Case "Baseball": fil = 37
                Case "Football": fil = 4
                Case "Golf": fil = 3
            End Select
            Set fnd = Cells(5, lCol).Resize(5, 7).Find(Day(rDate), LookIn:=xlValues, lookat:=xlWhole)
            fnd.Interior.ColorIndex = fil
        ElseIf Month(rDate) = 3 Then
            lCol = Rows(3).Find("March", LookIn:=xlValues, lookat:=xlWhole).Column
            Select Case rDate.Offset(0, 1).Value
                Case "Baseball": fil = 37
                Case "Football": fil = 4
                Case "Golf": fil = 3
            End Select
            Set fnd = Cells(5, lCol).Resize(5, 7).Find(Day(rDate), LookIn:=xlValues, lookat:=xlWhole)
            fnd.Interior.ColorIndex = fil
        End If
    Next rDate
    Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,309
Members
448,564
Latest member
ED38

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top