Yet another Excel Calendar

The image above demonstrates a calendar in Excel that allows you to:

• Add events. An event contains a date and time value, and a description.
• Select a cell. The events for that particular date is displayed.
• Easily spot events. Highlights dates containing events, a darker color indicates many events and a lighter fewer events.
• Browse worksheets. Easily navigate between years, months, and worksheets.
• Three worksheets named: "Calendar". "Month", "Day", and "Table".
• Code language. Utilizes VBA (Visual Basic for Applications).

1. How to use this Excel calendar

Calendar - yearly view

The first sheet is named "Calendar" and contains a calendar showing all dates, weekdays and if a date is highlighted it indicates one or more events. The row below the large year number lets you select a year. The calendar changes dates accordingly based on the selected year. See image above.

Calendar - table view

The Excel Table located in worksheet "Table" lets you specify event date and event text. Days with many "events" have a darker color, days with less "events" have a lighter color and dates without events are not highlighted at all.

The table to the right of the calendar shows all events for a selected day, the image above shows that date February 7th is selected and that date has two events.

Calendar - monthly view

Double-press with left mouse button oning on a month takes you to worksheet "Month" with that particular month's events.

The image above shows worksheet "Month", each day shows events. You can also press with left mouse button on a date and the table to the right shows all events for that day.

You can quickly jump between months and years using the top two rows. The first four "events" are shown in each date. Select a date and all events are displayed in the window to the right.

Calendar - daily view

Double-press with left mouse button oning on a date in worksheet "Calendar" takes you to worksheet "Day", see image below.

Worksheet day shows events based on the date you double-press with left mouse button oned on. Here you can select a date in the top right calendar, you also select an hour and the corresponding event is shown in the window to the right.

Double press with left mouse button on an event and you will be taken to sheet "Table" and the corresponding row, this makes it easy to find and edit a particular event. Likewise, if you double press with left mouse button on an empty cell, a new row is created with date and time, see picture below.

Back to top

2. How I built this workbook

This worksheet named "Table" contains all events, it is also here you add, delete or edit events. The worksheet contains an Excel Table that grows automatically when you enter new events.

Cell references to an Excel Table are called structured references and look differently than regular cell references.

Regular cell reference:

Structured reference:

You don't need to adjust these references in formulas which is the greatest advantage of using structured references.

Back to top

The "Calendar" worksheet has a few formulas that make the calendar dynamic meaning the years above the calendar change and dates in the calendar change when you select a year.

Formula in cell B4:

Formula in cell D4:

The TODAY() function returns the current date, the function is volatile meaning it is recalculated every time any cell in the worksheet is recalculated or calculated.

The YEAR function returns a number representing the current year minus 2. This means that row 4 contains years from two years back up to eight years in the future.

Formula in cell B8:

This formula calculates the first date in the first week, note that this date is probably not the first date for the selected year.

The DATE function has three arguments DATE( year, month, day)

Cell $K$2 contains the selected year, month is January represented by number 1. 2 is February, 3 is March ... 12 is December.

DATE($K$2, 1, 1)

becomes

DATE(2018, 1, 1)

and returns 43101 which is 1/1/2018, however, it is formatted to only show the day part of the date which is 1.

The following code is event code that starts a macro named "RefreshCal" if worksheet "Calendar" is activated meaning the user navigates to the worksheet.

'Event code that is rund if worksheet activated meaning selected
Private Sub Worksheet_Activate()

'Start macro RefreshCal
Call RefreshCal
End Sub

The following event code is also in worksheet" calendar.

• It takes you to worksheet "Day" if you double-press with left mouse button on a cell in cell range B6:X31 in worksheet "Calendar".
• It copies the date from the cell you double-press with left mouse button oned (if it has a formula) to worksheet date cell C2.

If the condition is not met then:

• Copy cell value from K2 in active worksheet to cell O5 in worksheet "Month"
• Copy value from target cell to cell O4 in worksheet "Month".
• Lastly, go to worksheet "Month".

'Event code that is rund before an Excel user doublepress with left mouse button ons a cell
Private Sub Worksheet_BeforeDoublePress with left mouse button on(ByVal Target As Range, Cancel As Boolean)

'Check if cell is in cell range B6:X31
If Not Intersect(Target, Range("B6:X31")) Is Nothing Then

    'Check if cell has a formula
    If Target.HasFormula Then

        'Save value from selected cell to cell C2 worksheet "Day"
        Worksheets("Day").Range("C2") = Target.Value

        'Go to worksheet "Day"
        Worksheets("Day").Activate

    'If cell is not in cell range B6:X31 then continue here
    Else

        'Save value in cell K2 in active worksheet to cell O5 in worksheet "Month"
        Worksheets("Month").Range("O5") = ActiveSheet.Range("K2")

        'Save value from target cell to cell O4 in worksheet "Month"
        Worksheets("Month").Range("O4") = Target.Value

        'Go to worksheet "Month"
        Worksheets("Month").Activate
    End If
End If
End Sub

The code below is also event code which is started if the user selects a cell.

• Make sure only one cell is selected and that the cell is in cell range B8:X31 then do the following:
  • If both conditions above match then save the target cell value (the selected cell) to cell AA8 on worksheet "Calendar".
  • Also save the month of the selected cell to worksheet "Month" cell O4.
• If the selected cell is in cell range B4:W4 and the number of selected cells are 2 then:
  • Copy the selected cells value to cell K2
  • Copy the selected cells value to cell O5 on worksheet "Month"
  • Run macro named RefreshCal
• If none of the conditions above are met then:
  • clear cell AA8

'This is an event macro that is run when a cell is selected
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Check if selected cell is in cell range B8:X31 and the number of selected cells are 1
If Not Intersect(Target, Range("B8:X31")) Is Nothing And Target.Cells.Count = 1 Then

        'Save selected cell value to cell AA8
        Range("AA8") = Target.Value

        'Save selected month to cell O4 in worksheet month
        Worksheets("Month").Range("O4") = Evaluate("INDEX(Month!$C$4:$N$4, MONTH(AA8))")

'Check if selected cell is in cell range B4:W4 and 2 cells are selected
ElseIf Not Intersect(Target, Range("B4:W4")) Is Nothing And Target.Cells.Count = 2 Then

        'Save selected cell value to cell K2
        Range("K2") = Target.Value

        'Save selected cell value to cell O5 in worksheet Month
        Worksheets("Month").Range("O5") = Target.Value

        'Start macro RefreshCal
        Call RefreshCal
Else

    'Clear cell AA8
    Range("AA8") = ""
End If
End Sub

Back to top

The event code in worksheet "Month" checks if the selected cell is in:

• cell range C4:N4 and only one cell is selected then
  • Copy/paste the selected cell value to cell O4 on worksheet "Month"
• cell range C5:N5 and only one cell is selected then
  • Copy/paste the selected cell value to cell O5 on worksheet "Month"
• cell range B8:O33 and only one cell is selected and if the value is a date then
  • Copy/paste the selected cell value to cell Q6
• cell is one of the cells in cell range B8:O33 then
  • Clear cell Q6
• cell is one of the remaining cells then
  • Clear cell Q6

'Event code rund when a cell is selected
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Check if selected cell is one of the cells in cell range C4:N4 and that only one cell is selected
If Not Intersect(Target, Range("C4:N4")) Is Nothing And Target.Cells.Count = 1 Then

        'Copy selected cell's value to cell O4
        Range("O4") = Target.Value

'Check if selected cell is one of the cells in cell range C5:N5 and that only one cell is selected
ElseIf Not Intersect(Target, Range("C5:N5")) Is Nothing And Target.Cells.Count = 1 Then

    'Copy selected cell's value to cell O5
    Range("O5") = Target.Value

    'Copy selected cell's value to cell K2 in worksheet Calendar
    Worksheets("Calendar").Range("K2") = Target.Value

'Check if selected cell is one of the cells in cell range B8:O33 and that only one cell is selected and if selected cell's value is a date
ElseIf Not Intersect(Target, Range("B8:O33")) Is Nothing And Target.Cells.Count = 1 And IsDate(Target.Value) Then

    'Copy selected cell's value to cell Q6
    Range("Q6") = Target.Value

'Check if selected cell is one of the cells in cell range B8:O33 
ElseIf Not Intersect(Target, Range("B8:O33")) Is Nothing Then

    'Save nothing to cell Q6
    Range("Q6") = ""
Else

    'Save nothing to cell Q6
    Range("Q6") = ""
End If
End Sub

Back to top

The event code in worksheet "Day" checks if the selected cell is in:

• in cell range E5:K10 and that only one cell is selected then
  • Copy/paste the selected cell value to cell C2
• in cell range B3:B26 and that only one cell is selected then
  • Copy/paste the selected cell value to cell E11

'Event macro is rund when a cell is selected
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Check if selected cell is one of the cells in cell range E5:K10 and that only one cell is selected
If Not Intersect(Target, Range("E5:K10")) Is Nothing And Target.Cells.Count = 1 Then

    'Copy selected cell's value to cell C2
    Range("C2") = Target.Value

'Check if selected cell is one of the cells in cell range B3:B26 and that only one cell is selected
ElseIf Not Intersect(Target, Range("B3:B26")) Is Nothing And Target.Cells.Count = 1 Then

    'Copy selected cell's value to cell E11
    Range("E11") = Target.Value
End If
End Sub

The next event code in worksheet "Day" is run before the user double-press with left mouse button ons a cell and checks if the selected cell is in:

• in cell range C3:C26 and if the selected cell is empty then
  • Navigate to worksheet "Table"
  • Save the row number of the cell that is being double-press with left mouse button oned
  • Select that cell in worksheet Table based on the row number
• if not then
  • select the first empty cell in column D on worksheet "Table"

'This event macro is rund before the user doublepress with left mouse button ons on a cell
Private Sub Worksheet_BeforeDoublePress with left mouse button on(ByVal Target As Range, Cancel As Boolean)

'Check if selected cell is one of the cells in cell range C3:C26
If Not Intersect(Target, Range("C3:C26")) Is Nothing Then

    'Check if selected cell's value is nothing (empty)
    If Target.Value <> "" Then

        'Go to worksheet Table
        Worksheets("Table").Activate
        
        'Dimension variable and declare data type
        Dim Drow As Single

        'Find row of the cell that is double-press with left mouse button oned on based on start date and time, save to variable Drow
        Drow = Evaluate("MATCH(" & Round(Target.Offset(0, -1).Value, 4) & ", Round(Table1[Start],4),0)")
        
        'Select that cell in worksheet Table
        Worksheets("Table").Range("D" & Drow + 2).Select
    Else
        Worksheets("Table").Activate
        Dim Lrow As Single
        Lrow = Worksheets("Table").Range("B" & Rows.Count).End(xlUp).Row
        Worksheets("Table").Range("B1").Select
        ActiveCell.Offset(Lrow).Select
        ActiveCell.Value = Target.Offset(0, -1).Value
    End If
End If
End Sub

Regular macros in the workbook:

'Name macro
Sub RefreshCal()

'Dimension variables and declare data types
Dim CRng As Variant
Dim Dt As Variant
Dim CDt As Variant
Dim Cnt As Integer
Dim r As Long
Dim c As Long
Dim St As Integer

'Disable screen from updating
Application.ScreenUpdating = False

'Save values in cell range B8:X40 to array variable CRng 
CRng = Worksheets("Calendar").Range("B8:X40").Value

'The With ... End With statement allows you to write shorter code by referring to an object only once instead of using it with each property.
With Worksheets("Calendar")

    'Iterate code between For and Next r based on the number of rows in array variable CRng
    For r = 1 To UBound(CRng, 1)

        'Iterate code between For and Next c based on the number of columns in array variable CRng
        For c = 1 To UBound(CRng, 2)

            '
            If CRng(r, c) <> "" Then
                For CDt = 1 To Range("Table1[Start]").Cells.Count
                    If CRng(r, c) >= Int(Range("Table1[Start]").Cells(CDt).Value) And CRng(r, c) <= Int(Range("Table1[End]").Cells(CDt).Value) Then Cnt = Cnt + 1 End If Next CDt End If If Cnt > St Then St = Cnt
        Cnt = 0
        Next c
    Next r
End With
Set Rng = Worksheets("Calendar").Range("B8:X40")
    'Remove previous formatting
    With Rng.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Worksheets("Calendar")
        For Each Dt In Worksheets("Calendar").Range("B6:X38")
            For CDt = 1 To Range("Table1[Start]").Cells.Count
                If Dt >= Int(Range("Table1[Start]").Cells(CDt).Value) And Dt <= Int(Range("Table1[End]").Cells(CDt).Value) Then Cnt = Cnt + 1 End If Next CDt If Cnt > 0 Then
            With Dt.Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = Worksheets("Calendar").Range("AB6").Interior.Color ' xlThemeColorAccent4 '
                .TintAndShade = 1 - (Cnt / St)
                .PatternTintAndShade = 0
            End With
            'Reset counter a
            Cnt = 0
            End If
        Next Dt
    End With
Application.ScreenUpdating = True
End Sub

Back to top

Recommended articles

• Yearly Calendar Templates
• Microsoft Office - Calendars
• Excel Calendar templates

Get the Excel file

Yet-another-excel-calendar.xlsm

Back to top

Calendar category

Excel calendar
Table of Contents Excel monthly calendar - VBA  Calendar Drop down lists Headers Calculating dates (formula) Conditional formatting Today Dates […]

Plot date ranges in a calendar
Table of Contents Plot date ranges in a calendar Plot date ranges in a calendar part 2 Highlight events in […]

Monthly calendar template
Table of Contents Monthly calendar template Monthly calendar template 2 Calendar - monthly view - Excel 365 Calendar - monthly […]

Excel categories

Comments (3)