tomleslie.ca

A sparkline is a miniature line graph that shows trending information over a time period. It is designed to be shown next to the name of a data type in a table of data to show a quick “at a glance” reference of how the data is trending over time. Microsoft is introducing sparklines as a patented new feature in Excel 2010, which is causing some controversy as the concept was actually invented by Edward Tufte. In any case, I wanted to use sparklines now, not wait for Office 2010, so I wrote the macro below.

To use it, select your data set (must be in a single row but need not be contiguous) and then (holding down the control button) the cell where you want the sparkline inserted. Then run the macro, which should create a nice little line graph and align it to the cell you’ve chosen.

Please note that the macro has no error detection & handling logic of any kind so if your experience is not a happy one you are completely on your own. Have a nice day.


Sub Sparkline()
'
' Sparkline Macro
' Macro written 14/06/2010 by Tom Leslie
'
' Creates a sparkline graph and inserts it into the selected cell (the last in the range)

Dim iRangeWidth As Integer
Dim rTargetCell As Range
Dim rDataRange As Range
Dim iMin, iMax As Double
Dim sSheet As Worksheet
Dim cChart As Chart
Dim strChartName As String

Set rTargetCell = Selection.Areas(Selection.Areas.Count).Cells(Selection.Areas(Selection.Areas.Count).Cells.Count)

If Selection.Areas.Count = 1 Then
iRangeWidth = Selection.Cells.Count – 1
Set rDataRange = Range(Selection.Cells(1), Selection.Cells(iRangeWidth))
Else
Set rDataRange = Selection.Areas(1)
iRangeWidth = rDataRange.Cells.Count
For i = 2 To Selection.Areas.Count – 1
Set rDataRange = Union(rDataRange, Selection.Areas(i))
iRangeWidth = rDataRange.Cells.Count
Next i
End If

iMin = Application.Min(rDataRange)
iMax = Application.Max(rDataRange)

rDataRange.Select
Set sSheet = ActiveSheet

Charts.Add
Set cChart = ActiveChart
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=rDataRange, PlotBy:=xlRows
ActiveChart.Location Where:=xlLocationAsObject, Name:=sSheet.Name
With ActiveChart.Axes(xlValue)
.MinimumScale = iMin – (iMax – iMin) * (1 / rTargetCell.Height)
.MaximumScale = iMax + (iMax – iMin) * (1 / rTargetCell.Height)
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = False
.HasAxis(xlValue, xlPrimary) = False
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = False
.HasMinorGridlines = False
End With
ActiveChart.HasLegend = False
With Selection.Border
.Weight = 1
.LineStyle = 0
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.PlotArea.Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlNone
End With
Selection.Interior.ColorIndex = xlNone
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.ColorIndex = 17
.Weight = xlMedium
.LineStyle = xlContinuous
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlNone
.MarkerStyle = xlNone
.Smooth = False
.MarkerSize = 3
.Shadow = False
End With
ActiveChart.PlotArea.Height = rTargetCell.Height / 2
ActiveChart.Refresh
Debug.Print ActiveChart.PlotArea.Height
strChartName = Right(ActiveChart.Name, Len(ActiveChart.Name) – Len(sSheet.Name))
With ActiveSheet.Shapes(strChartName)
.Left = rTargetCell.Left
.Top = rTargetCell.Top – 3
.LockAspectRatio = False
.Width = rTargetCell.Width
.Height = rTargetCell.Height + 6
Debug.Print “Target:” & .Height
Debug.Print ActiveChart.ChartArea.Height
End With
ActiveChart.Refresh
With ActiveChart.PlotArea
.Left = 0
.Top = 0
End With
ActiveSheet.Cells(1, 1).Select
sSheet.ChartObjects(strChartName).Select
ActiveChart.PlotArea.Height = rTargetCell.Height
ActiveChart.PlotArea.Width = rTargetCell.Width
Debug.Print “Height:” & ActiveChart.ChartArea.Height & “:” & ActiveChart.PlotArea.Height

End Sub