Spark Something Off

SparkHeaderFinal

A sparkline is a small intense, simple, word-sized graphic with typographic resolution. – Edward Tufte

Today, I’ll look at how I might be able to :

  • Dynamically find a Range of data by finding the first and last Cells of data
  • Add a SparkLine Group for the data Range
  • Format the Sparklines and add markers for various SparkPoints
  • Add appropriate SparkAxes to be used as reference lines for visualizing actual values vs target values

 

The Data

First, I’ll need some data. I’d like some QA data for some Reps for each month of 2014. I demonstrated how to create this test data previously using Cartesian Products in MS Access – so I won’t go through all of those steps again. Make sure you check out the link to understand the steps for creating the test data.

SparklineData3

Here is the final data summarized by Rep and by Month:

SparklineData4

Delete Existing SparkLine Groups

First, I’ll need to delete any existing SparkLine Groups from previous runs:

Option Explicit

Public Sub DeleteSparklines(ws As Worksheet)

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'DeleteSparklines
    'Deletes any Sparkline Groups from the specified worksheet
    '
    'Parameters        :
    'ws                :   Required, A Woksheet Object.
    '
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Declare objects
        Dim rng As Range
        Dim sg As SparklineGroup

    'Error handler
        On Error Resume Next

    'Initialize
        Set rng = ws.UsedRange

    'Delete Sparkline Groups if any exist
        With rng
            For Each sg In rng.SparklineGroups
                sg.Delete
            Next sg
        End With

ErrHandler:
    If Err.Number > 0 Then _
        MsgBox Err.Description, vbMsgBoxHelpButton, "Delete SparkLine Group", Err.HelpFile, Err.HelpContext
        Err.Clear

    'Tidy up
        Set rng = Nothing
End Sub

Find Last Cell With Data

Next, I’ll need to find the last cell with data on the worksheet:

Public Function GetLastCell(ws As Worksheet, _
                            rngBegin As Range) As Range

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'GetLastCell
    'Returns a Range Object as a Cell.
    '
    'Parameters        :
    'ws                :   Required, A Woksheet Object.
    'rng               :   Required, A Range Object.
    '                      Use xlPrevious when searching for the last used Cell.
    '                      Use xlNext when searching or the first used cell.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Declare objects
        Dim rng As Range

    'Get range as a single cell
        With ws
            Set rng = .Cells.Find(What:="*", _
                                  After:=rngBegin, _
                                  LookIn:=xlFormulas, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlPrevious, _
                                  MatchCase:=False)
        End With

    'Pass the range to the function
        Set GetLastCell = rng

    'Tidy up
        Set rng = Nothing

End Function

Find First Cell With Data

Now that I have the last cell with data, I can find the first cell with data. Note in the function below, I added a third parameter to include labels or not:

SparkLineRemoveLabels

Public Function GetFirstCell(ws As Worksheet, _
                             rngBegin As Range, _
                             IncludeLabels As Long) As Range

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'GetFirstCell
    'Returns a Range Object as a Cell.
    '
    'Parameters        :
    'ws                :   Required, A Woksheet Object.
    'rng               :   Required, A Range Object.
    '                      Use xlPrevious when searching for the last used Cell.
    '                      Use xlNext when searching or the first used cell.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    'Declare objects
        Dim rng As Range

    'Declare variables
        Dim r As Long
        Dim c As Long

    'Get range as a single cell
        With ws
            Set rng = .Cells.Find(What:="*", _
                                  After:=rngBegin, _
                                  LookIn:=xlFormulas, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  MatchCase:=False)
        End With

    'Remove row and column labels if needed
        Select Case IncludeLabels
            Case 2                          'Do not include labels
                With rng
                    r = .Row + 1
                    c = .Column + 1
                End With

                With ws
                    Set rng = .Cells(r, c)
                End With
            Case Else
                'Do nothing
        End Select

    'Pass the range to the function
        Set GetFirstCell = rng

    'Tidy up
        Set rng = Nothing

End Function

Create A Range For The Data Source

Next, I’ll create a Range to be used as the data source for the SparkLine Group using the last cell and the first cell on the worksheet:

Set rngSparkLineSource = ws.Range(firstcell, lastcell)

Create A Range For The SparkLine Group

Now that I have the first and last cell of the data source Range, I can create a Range for the SparkLine Group:

 lngSparkLineColumn = lastcell.Column + 1                                    'Move to next blank column
        lngSparkLineLastRow = lastcell.Row
        lngSparkLineFirstRow = firstcell.Row
        With ws
            Set rngSparkLineDestination = .Range(.Cells(lngSparkLineFirstRow, lngSparkLineColumn), _
                                                 .Cells(lngSparkLineLastRow, lngSparkLineColumn))
         End With

Create The SparkLine Group

One of the required parameters of the SparkLine Group Object is source data as a string. I have the source data as a Range, so I need to create a string from the Range in the form of Worksheet!Range.Address:

Option Explicit

Public Function GetSparkLineGroup(rngSparkLinePlacement As Range, _
                                  rngSparkLineSourceData As Range) As SparklineGroup

        'Declare objects
            Dim slg As SparklineGroup

        'Delare variables
            Dim strSourceData As String

        'Error handler
            On Error GoTo ErrHandler

        'Source data address as qualified string
            strSourceData = rngSparkLineSourceData.Parent.Name & _
                            "!" & _
                            rngSparkLineSourceData.Address

        'Add SparkLine Group
             Set slg = rngSparkLinePlacement.SparklineGroups.Add(Type:=xlSparkLine, _
                                                               SourceData:=strSourceData)

        'Pass object to function
            Set GetSparkLineGroup = slg

ErrHandler:
        If Err.Number > 0 Then _
            MsgBox Err.Description, vbMsgBoxHelpButton, "Create SparkLine Group", Err.HelpFile, Err.HelpContext

        'Tidy up

            Set slg = Nothing

End Function

SparkLineGroup2

SparkLine Group Formatting

Everything is looking great so far! Next, I would like to add a little formatting to the SparkLine Group. In the Sub I created, I set the default visibility for Highpoint, Lowpoint and EndPoint to true, but I can easily change to false when I call the Sub. I’ll leave the default values for now:

Option Explicit

Public Sub FormatSparkLineGroup(slg As SparklineGroup, _
                                lngColorLine As Long, _
                                lngColorHighpoint As Long, _
                                lngColorLowpoint As Long, _
                                lngColorLastPoint As Long, _
                                Optional ByVal blnVisHighpoint As Boolean = True, _
                                Optional ByVal blnVisLowpoint As Boolean = True, _
                                Optional ByVal blnVisLastpoint As Boolean = True)

    'Error handler
        On Error GoTo ErrHandler

    'Line Settings
        With slg
            .LineWeight = 1.3
            .SeriesColor.Color = lngColorLine
        End With

    ' High point settings:
        With slg.Points.Highpoint
            .Visible = blnVisHighpoint
            .Color.Color = lngColorHighpoint
        End With

    ' Low point settings:
        With slg.Points.Lowpoint
            .Visible = blnVisLowpoint
            .Color.Color = lngColorLowpoint
        End With

    ' End point settings:
        With slg.Points.Lastpoint
            .Visible = blnVisLastpoint
            .Color.Color = lngColorLastPoint
        End With

ErrHandler:
        If Err.Number > 0 Then _
            MsgBox Err.Description, vbMsgBoxHelpButton, "Format SparkLines", Err.HelpFile, Err.HelpContext

End Sub

SparkLineGroupFormatted2

Looks better! I tried the line weight at 1.5 and thought it was too thick and made the Low, High and Endpoint Markers disappear, so I settled on a line weight of 1.3.

Horizontal Axis As A Reference Line

The Sparklines look good, but we can make them better by adding a reference line to compare actual values vs a target. To dynamically add a Horizontal Axis as a Reference Line, I’ll need to do a few things:

  • Add a Worksheet to hold all calculations for the Horizontal Axis
  • Determine the size of the range of the source data
  • Create a Range on the new Worksheet the same size as the source Range
  • Add a formula to the new Range to calculate the difference between actual and target values
  • Use the resultant Range as the source Range for the SparkLine Group
  • Determine the appropriate vertical scale

Add A Workshsheet

I’ll add a Worksheet and name it “SparklineData”. Before I can create the Worksheet, I need to check if it already exists. If it does exist, delete it and then add it:

 'Check if a worksheet named "SparklineData" already exists, if it does, delete it
        With wb
            For Each sh In .Worksheets
                If sh.Name = "SparklineData" Then sh.Delete
            Next sh
        End With

    'Add a worksheet for horizontal axis value calculations
        Call AddWorksheet(wb:=wb, _
                          strSheetName:="SparklineData")
        Set wsSparklineData = wb.Worksheets("SparklineData")

The Sub:

Option Explicit

Public Function AddWorksheet(wb As Workbook, _
                             strSheetName As String) As Object

    'Declare variables
        Dim ws As Worksheet

    'Error handler
        On Error GoTo ErrHandler

    'Add worksheet
        With wb
            Set ws = .Sheets.Add(After:=.Sheets(wb.Sheets.Count))
            ws.Name = strSheetName
        End With

    'Pass object to function
        Set AddWorksheet = ws

ErrHandler:
    If Err.Number > 0 Then _
        MsgBox Err.Description, vbMsgBoxHelpButton, "Add a worksheet", Err.HelpFile, Err.HelpContext

    'Tidy up
        Set ws = Nothing

End Function

Create A Range To Contain Calculations

Now that I have a Worksheet, I need to add a Range to hold calculations that are the difference of my target value less actual performance. I want the Range to begin in the same cell and contain the same number of Rows and Columns as the Range that contains my actual values:

'Create a Range on the Sparkline Data Worksheet
    'The Range should be the same size as the Source Data Range
        With rngSparkLineSource
            lngRowFirstSource = .Row
            lngColFirstSource = .Column
            lngRowsSource = .Rows.Count
            lngColsSource = .Columns.Count
        End With

        With wsSparklineData
            Set rngData = .Cells(lngRowFirstSource, lngColFirstSource)
            Set rngData = rngData.Resize(lngRowsSource, lngColsSource)
        End With

Add A Formula To Calculate Variance: Target Vs Actual

Now that I have a Range, I need to add a formula to each Cell in the Range to calculate the the variance between target and actual values:

    'Add a formula to the Data Range to determine the difference between Target and Actual
        For j = 1 To lngColsSource
            For i = 1 To lngRowsSource
                rngData.Cells(i, j).Value = rngSparkLineSource.Cells(i, j).Value - lngTARGET
            Next i
        Next j

Use Variance Calculations As Data Source For SparkLine Group

Now, that I have calculated variances (Target – Actual) I’ll use the resultant Range as the data source for the Sparkline Group. See the GetSparkLineGroup Function above. Take note that I am using the variance calculations as the source for the SparkLine Group, but the Sparklines are being presented next to the Actual values:

    'Add SparkLine Group
        Set slg = GetSparkLineGroup(rngSparkLinePlacement:=rngSparkLineDestination, _
                                    rngSparkLineSourceData:=rngAxis)

Add Sparkline Axes As A Horizontal Reference Line

Lastly, I would like to add a Horizontal Axis as a reference line to compare actual values to a target value. The money shot here is if all values are below the target value or if all values are above the target value – in both cases, the Vertical Axis requires a Custom Scale Value. In the code below, I loop through the columns in each row and compare the value to the target value and increment counters depending if the value is greater or less than target. Finally I determine if the lesser or greater count is equal to the number of columns in the row and set the vertical axis accordingly:

Option Explicit

Public Sub FormatSparklineAxes(ws As Worksheet, _
                               rngSparkLineGroup As Range, _
                               rngSparkLineSourceData As Range, _
                               lngValueForComparison As Long, _
                               lngColorHorizontalAxis As Long, _
                               Optional ByVal blnVisHorizontalAxis As Boolean = True)

    'rngSparkLineGroup contains a sparkline group
    'rngSparkLineSourceData contains the data that will be compared to the target value
    'Value for comparison will be used to compare

    'Declare variables
        Dim i As Long                               'Loop through data source rows
        Dim j As Long                               'Loop through data source columns
        Dim lngColumnsDataSource As Long            'Number of columns in SparkLine Group data source
        Dim lngRowSparkLineGroup As Long            'Row number of individual sparkline
        Dim lngValueGreater As Long                 'Counter - number of values in source greater than target
        Dim lngValueLesser As Long                  'Counter - number of values in source lesser than target

    'Declare objects
        Dim rngRegroupSparklines As Range
        Dim sg As SparklineGroup

    'Error handler
        On Error GoTo ErrHandler

    'Initialize objects and variables
        lngColumnsDataSource = rngSparkLineSourceData.Columns.Count
        i = 1

    'Ungroup sparklines
        rngSparkLineGroup.SparklineGroups.Ungroup

    'Determine vertical axis placement for each sparkline
        For Each sg In rngSparkLineGroup.SparklineGroups
            i = sg.Location.Row
            lngValueLesser = 0
            lngValueGreater = 0
            For j = 1 To rngSparkLineSourceData.Columns.Count
                If ws.Cells(i, j + 1).Value < lngValueForComparison Then
                    lngValueLesser = lngValueLesser + 1
                ElseIf rngSparkLineSourceData.Cells(i, j + 1).Value > lngValueForComparison Then
                    lngValueGreater = lngValueGreater + 1
                Else
                    'Source data value is equal to target value - axis will plot properly, no action needed
                End If
            Next j

            'Set sparkline axes based on source data values
            'If all values are greater than target value, set the Min axis value to zero
            'If all values are less than target value, set the Max axis value to zero

            With sg.Axes
                If lngValueLesser = lngColumnsDataSource Then
                    .Vertical.MaxScaleType = xlSparkScaleCustom
                    .Vertical.CustomMaxScaleValue = 0
                ElseIf lngValueGreater = lngColumnsDataSource Then
                    .Vertical.MinScaleType = xlSparkScaleCustom
                    .Vertical.CustomMinScaleValue = 0
                Else
                    .Vertical.MaxScaleType = xlSparkScaleSingle
                End If
                    .Horizontal.Axis.Visible = blnVisHorizontalAxis
                    .Horizontal.Axis.Color.Color = lngColorHorizontalAxis
            End With
        Next sg

ErrHandler:
    If Err.Number > 0 Then _
        MsgBox Err.Description, vbMsgBoxHelpButton, "Format sparkline axes", Err.HelpFile, Err.HelpContext
        Err.Clear

End Sub

SparklinesFinal2

The Main Sub()

Here is the main Sub() that calls all other Subs() and Functions():

Option Explicit

Sub CreateSparkLines()

    'Declare objects
        Dim wb As Workbook
        Dim ws As Worksheet
        Dim sh As Worksheet
        Dim wsSparklineData As Worksheet
        Dim slg As SparklineGroup
        Dim rngSparkLineSource As Range
        Dim rngSparkLineDestination As Range
        Dim lastcell As Range
        Dim firstcell As Range
        Dim rngData As Range

    'Declare variables
        Dim lngSparkLineColumn As Long
        Dim lngSparkLineFirstRow As Long
        Dim lngSparkLineLastRow As Long
        Dim RowHeader As Long
        Dim lngRowsSource As Long
        Dim lngColsSource As Long
        Dim lngRowFirstSource As Long
        Dim lngColFirstSource As Long
        Dim i As Long
        Dim j As Long

    'Declare constants
        Const lngTARGET As Long = 98
        Const lngTargetAxis As Long = 0

    'Excel environment
        With Application
            .DisplayAlerts = False
        End With

    'Initialize objects and variables
        Set wb = ThisWorkbook
        Set ws = wb.Worksheets(1)

    'If any previous Sparkline Groups - delete them
        Call DeleteSparklines(ws:=ws)

    'Create a Range Object as the source for the Sparkline Group
        On Error Resume Next
        Set lastcell = GetLastCell(ws:=ws, _
                                   rngBegin:=ws.Cells(1, 1))

        If Not lastcell Is Nothing Then
            Set firstcell = GetFirstCell(ws:=ws, _
                                         rngBegin:=lastcell, _
                                         IncludeLabels:=xlNo)

            Set rngSparkLineSource = ws.Range(firstcell, lastcell)
        Else
            MsgBox "No data exists on the selected sheet"
            Err.Raise 513
        End If

    'Create a Range Object as the destination for the Sparkline Group
        lngSparkLineColumn = lastcell.Column + 1
        lngSparkLineLastRow = lastcell.Row
        lngSparkLineFirstRow = firstcell.Row
        With ws
            Set rngSparkLineDestination = .Range(.Cells(lngSparkLineFirstRow, lngSparkLineColumn), _
                                                 .Cells(lngSparkLineLastRow, lngSparkLineColumn))
         End With

    'Add header
        RowHeader = rngSparkLineDestination.Row - 1
        ws.Cells(RowHeader, lngSparkLineColumn).Value = "Trend"

    'Check if a worksheet named "SparklineData" already exists, if it does, delete it
        With wb
            For Each sh In .Worksheets
                If sh.Name = "SparklineData" Then sh.Delete
            Next sh
        End With

    'Add a worksheet for horizontal axis value calculations
        Call AddWorksheet(wb:=wb, _
                          strSheetName:="SparklineData")
        Set wsSparklineData = wb.Worksheets("SparklineData")

    'Create a Range on the Sparkline Data Worksheet
    'The Range should be the same size as the Source Data Range
        With rngSparkLineSource
            lngRowFirstSource = .Row
            lngColFirstSource = .Column
            lngRowsSource = .Rows.Count
            lngColsSource = .Columns.Count
        End With

        With wsSparklineData
            Set rngData = .Cells(lngRowFirstSource, lngColFirstSource)
            Set rngData = rngData.Resize(lngRowsSource, lngColsSource)
        End With

    'Add a formula to the Data Range to determine the difference between Target and Actual
        For j = 1 To lngColsSource
            For i = 1 To lngRowsSource
                rngData.Cells(i, j).Value = rngSparkLineSource.Cells(i, j).Value - lngTARGET
            Next i
        Next j

    'Add SparkLine Group
        Set slg = GetSparkLineGroup(rngSparkLinePlacement:=rngSparkLineDestination, _
                                    rngSparkLineSourceData:=rngData)

    'Format SparkLine Group
        Call FormatSparkLineGroup(slg:=slg, _
                                  lngColorLine:=RGB(128, 128, 128), _
                                  lngColorHighpoint:=RGB(0, 0, 0), _
                                  lngColorLowpoint:=RGB(255, 0, 0), _
                                  lngColorLastPoint:=RGB(0, 0, 0))

    'Format SparkLine Group Axes
        Call FormatSparklineAxes(ws:=wsSparklineData, _
                                 rngSparkLineGroup:=rngSparkLineDestination, _
                                 rngSparkLineSourceData:=rngData, _
                                 lngValueForComparison:=lngTargetAxis, _
                                 lngColorHorizontalAxis:=RGB(217, 217, 217))

    'Return focus to the report
        ws.Activate

ErrHandler:
    If Err.Number > 0 Then _
        MsgBox Err.Description, vbMsgBoxHelpButton, "Create Sparkline Group", Err.HelpFile, Err.HelpContext
        Err.Clear

    'Tidy up
        Set lastcell = Nothing
        Set firstcell = Nothing
        Set rngSparkLineSource = Nothing
        Set rngSparkLineDestination = Nothing
        Set slg = Nothing
        Set ws = Nothing
        Set wsSparklineData = Nothing
        Set wb = Nothing

        With Application
            .DisplayAlerts = True
        End With

End Sub

Excel Sparkline Improvements Are Needed

I like sparklines, they are excellent in dashboards when screen real estate is a premium. They are also excellent for exploratory data analysis. But there is room for improvement:

  • Horizontal Axis Range I would like the reference line to have a minimum and maximum range option. For example, for purposes of this post, I used a target value of 98 and a thin grey line was plotted for each sparkline based on the actual values for each data source row. But many times, we would like to view actual QA values against a scale, say 97-98 for example.
  • Spark Markers More options are needed for formatting Spark Markers for beginning, ending, high and low data points. We need to be able to use different shapes and sizes. In the current implementation, the Spark Markers are a bit hard to visualize.

Downloads

You may download the Excel Workbook and/or the code modules (.bas files) from OneDrive.

DownloadSparklines

  • M_CreateSparklines.bas
  • M_FormatSparklineAxes.bas
  • M_FormatSparklines.bas
  • M_RangeObject.bas
  • M_SparklinesAdd,bas
  • M_SparklinesDelete.bas
  • M_Worksheet.bas

Additional Resources – Sparklines

Tidy Up

This post was about using VBA to:

  • Dynamically determine a data range on a worksheet
  • Add a Sparkline Group to the next available column
  • Format the Sparkline Group for line and Spark Points
  • Add the appropriate Axis to each Sparkline Group to be used as a reference to compare actual values to target values

In my next post on Sparklines, I will look at how we might use Sparklines with Pivot Tables…stay tuned.

, , , , ,
Trackback

no comment untill now

Add your comment now