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.
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
'https://myengineeringworld.net/////
'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.
