Article updated on April 19, 2018

heat map calendar

David asks:

Hi, I would like to use this example with my dataset, however, I'd like to visually show the number of events per date to understand when are we the busiest, slowest, etc. and be able to forecast using this data.

Ideally, I would like some sort of data bar or color change indicating the level for each date (Jan 1 has 10 items while Jan 2 has 3 and I can visually see that in each cell instead of seeing numbers or a solid color for each cell (here yellow and blue).

Answer:

This article demonstrates how to highlight events on a yearly calendar based on frequency per day. You will find a link to this workbook at the end of this article.

The color on the calendar gives a rough estimate on the number of events per date.

  • No color no events.
  • Light color one or a few events.
  • Darker color means many events.

You add, edit or delete events to worksheet "Table" and every time you go back to worksheet "Calendar" the colors are refreshed by the macro below.

There is a specific cell next to the calendar that allows you to change the highlight color if you prefer. Click on that cell and change the cell color to a color you want.

VBA code

  1. Right click on sheet Calendar
  2. Click "View Code"
    heat map calendar - sheet
  3. Copy vba code below
  4. Paste code to sheet module
  5. Exit VB Editor
Private Sub Worksheet_Activate()
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
Application.ScreenUpdating = False
CRng = Worksheets("Calendar").Range("B6:X38").Value
With Worksheets("Table")
    For r = 1 To UBound(CRng, 1)
        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("B6:X38")
    'Remove previous formatting
    With Rng.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Worksheets("Table")
        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("AB5").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

WorkSheet "Table"

The picture below shows the events in an Excel defined table named [Table1].

You don't need to adjust cell references or formulas everything is automatic, Excel defined Tables are great in that aspect.

heat map calendar - table

You can find a heat map monthly calendar here.

Download excel *.xlsm file

Heat map calendar.xlsm