Create Sparklines Automatically

Share this

September 27, 2012

Create Sparklines Automatically

This is the second project I completed in response to my VBA offer. Matthias from Stuttgart asked me if is possible to automate the creation of sparklines. First of all, what is a sparkline? Well, according to Wikipedia “A sparkline is a very small line chart, typically drawn without axes or coordinates. It presents the general shape of the variation (typically over time) in some measurement, such as temperature or stock market price, in a simple and highly condensed way.”

Sparklines are a new feature of Excel 2010 and are quite useful, since you can have a quick overview of what is going on to your data in a single cell! Matthias for example had hourly measurements and he wanted to create sparkline charts for each day, month and quarter. So, the purpose of the code below is to automate the creation of sparklines.

VBA Code

Option Explicit

Sub CreateSparklines()
    'This macro creates sparklines in the column next to the last column of the sheet.
    'Input data must be in the range (B2: Last Row Last Column).
    'Next to sparkline column it writes the min and max of sparkline.
    'By Christos Samaras
    'Declaring the necessary variables.

Dim LastRow As Long
Dim LastColumn As Long
Dim AfterLastColumnLetter As String
Dim myBorders() As Variant
Dim Item As Variant
Dim i As Long
Dim RowMin As Double
Dim RowMax As Double
    'This array contains the names of the four edges of a border.
    myBorders = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight)
    'Only office 2010 supports sparklines.
    If Application.Version = "12.0" Or _
        Application.Version = "11.0" Or _
        Application.Version = "10.0" Or _
        Application.Version = "9.0" Or _
        Application.Version = "8.0" Or _
        Application.Version = "7.0" Then
        MsgBox "Sorry, this macro cannot run properly in office prior to 2010!", _
                vbCritical, "Office Version Error"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    'Find last row and last column of data.
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
    End With
    'Here is a trick to convert the column number to letter.
    AfterLastColumnLetter = Mid(Cells(2, LastColumn + 1).Address, _
    InStr(Cells(2, LastColumn + 1).Address, "$") + 1, _
    InStr(2, Cells(2, LastColumn + 1).Address, "$") - 2)
    'Set the sparkline heading and format it.
    Range(AfterLastColumnLetter & 1).Select
    With Selection
        .Value = "SPARKLINE"
        With .Font
            .Name = "Arial"
            .Size = 11
            .ColorIndex = xlAutomatic
            .Bold = True
        End With
    End With
    'Using an array to make all borders thick.
    For Each Item In myBorders
        With Selection.Borders(Item)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    Next Item
    'Make sparkline cells more visible.
    With ActiveSheet
        .Rows("2:" & LastRow).RowHeight = 33.75 '45 pixels
        .Columns(AfterLastColumnLetter).ColumnWidth = 13.57 '100 pixels
    End With
    'Create the sparklines.
    Range(Cells(2, LastColumn + 1), Cells(LastRow, LastColumn + 1)).Select
    Selection.SparklineGroups.Add Type:=xlSparkLine, _
    SourceData:=Range(Cells(2, 2), Cells(LastRow, LastColumn)).Address
    'Format the sparklines.
    With Selection.SparklineGroups.Item(1)
        .SeriesColor.Color = RGB(112, 48, 160)
        .LineWeight = 1.5
        With .Points
            .Highpoint.Visible = True
            .Highpoint.Color.Color = RGB(0, 176, 240)
            .Lowpoint.Visible = True
            .Lowpoint.Color.Color = RGB(255, 0, 0)
        End With
    End With
    'Format the cell borders.
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        With .Borders
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
    End With

    'Make the external borders thick.
    For Each Item In myBorders
        With Selection.Borders(Item)
            .LineStyle = xlContinuous
            .Weight = xlMedium
            .ColorIndex = xlAutomatic
        End With
    Next Item
    'Find the min and max of each sparkline and write them to the next column (left).
    'The min and max values are formatted in a way to fit to the cell height.
    'Furthermore the min and max color matches the sparkline min and max colors.

    For i = 2 To LastRow
        'Calculate the min and max of the row.
        RowMin = WorksheetFunction.Min(Range(Cells(i, 2), Cells(i, LastColumn)))
        RowMax = WorksheetFunction.Max(Range(Cells(i, 2), Cells(i, LastColumn)))
        'Write min and max in the column next to sparkline.
        With Cells(i, LastColumn + 2)
            .Value = RowMax & vbLf & vbLf & RowMin
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .Font.Size = 8
            .Font.Color = RGB(255, 0, 0)
            .Font.Bold = True
            .WrapText = True
            'Change the color of max value to fit with sparkline max color.
            .Characters(Start:=1, Length:=Len(CStr(RowMax))).Font.Color = RGB(0, 176, 240)
        End With
    Next i
    Cells(2, LastColumn + 1).Select
    Application.ScreenUpdating = True
End Sub

How to use it

The short video below demonstrates the sparklines that are created from daily, monthly and quarterly measurements of the previous year (2011).

Download it from here

The file can be opened only with Office 2010. Please, remember to enable macros before using it.

Page last modified: January 6, 2019

Christos Samaras

Hi, I am Christos, a Mechanical Engineer by profession (Ph.D.) and a Software Developer by obsession (10+ years of experience)! I founded this site back in 2011 intending to provide solutions to various engineering and programming problems.

{"email":"Email address invalid","url":"Website address invalid","required":"Required field missing"}
Add Content Block