Creating Animated Chart GIFs with Excel VBA

7 min readSep 27, 2020

Do you have some complex charts and slides you, or your client, want posted on Twitter, LinkedIn, Medium, FB or almost any web page?

Here’s output from this project. Tracking Covid and Temperature in Massachusetts.

Is one chart not enough to tell your story? Are you limited by what you can post on Twitter, say? (where you can’t use Javascript libraries).

I want a one-stop solution for robust internet API calls, data extraction, transformations, charting, SFTP uploads, etc. So I used Excel VBA and command-line apps to create animated GIFs. The following is a template that can be quickly modified to create chart PNGs, JPGS, or animated GIFs. I can even schedule it to run automatically through a cron job on my PC.

You can Download zip file. This VBA solution is meant to get someone who programs up and running.

Another benefit of Excel, over Python, is that it is easy to give to anyone, and they can run it, without knowing a thing about programming languages, libraries IDEs, and so forth. If they have Excel, they’re good to go!

Here’s a sample of the animated GIF output

The VBA code below will pick up configuration data from my master sheet. Although I’m not using ODBC databases here, I’ve left in the possibility to add them later. Yes, this is crude, but all the end-user sees are the charts!

Data

For the Covid data I download the latest history file from covidtracking.com (Apologies for my lazy and unorthodox programming style). Also, I only expect the reader to skim over the code. Again, I just want to get things done so some of the code was created by the macro-recorder which I copy-and-pasted in procedures.

Sub DOCAA_s01_Download_Data_CSV_Covid()Dim ws As Worksheet
Dim sURL, sUseSheet, sThisSheet As StringsThisSheet = ActiveSheet.Name ' The master sheet we create charts on fromsUseDataSheet = "Data_COVID"
sURL = "https://covidtracking.com/data/download/massachusetts-history.csv"' Delete old data sheet if exists
For Each ws In Worksheets
    If ws.Name = sUseSheet Then
        Application.DisplayAlerts = False
        Sheets(sUseDataSheet).Delete
        Application.DisplayAlerts = True
    End If
Next
' Create sheet ' After:=Sheets(Sheets.Count)
Sheets.Add(Before:=Sheets(1)).Name = sUseSheet' Download CSV and add to sheet
Set ws = ActiveWorkbook.Sheets(sUseDataSheet)
With ws.QueryTables.Add(Connection:="TEXT;" & sURL, Destination:=ws.Range("A1"))
    .TextFileParseType = xlDelimited
    .TextFileCommaDelimiter = True
    .Refresh
End WithCells.Select
ActiveWorkbook.Worksheets(sUseDataSheet).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(sUseDataSheet).Sort.SortFields.Add2 Key:=Range( _
    "A2:A248"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets(sUseDataSheet).Sort
    .SetRange Range("A1:AQ1000")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Range("A1").Select' Delete the attached "Excel memorized" querytable if there is one
On Error GoTo nothingtodelete
    Sheets(sUseSheet).QueryTables(1).SaveData = False
    Sheets(sUseSheet).QueryTables.item(1).Delete
nothingtodelete:' return to calling master sheet
Sheets(sThisSheet).SelectEnd Sub

For the weather data, we’ll need to use this open-source VBA-tools/VBA_JSON library. It’s probably overkill. Nonetheless, whatever works out of the box I use. There is VBA code for just about anything,a quick internet search away.

Sub DOCAA_s03_Download_Data_JSON_Weather()
Dim sAPI, sThisSheet As String
Dim response
Dim jsonObject As Object, item As Object
Dim ws As WorksheetsThisSheet = ActiveSheet.Name ' current master sheet' ***
' PREPARE SHEET
' ***
sUseDataSheet = "Data_Weather"' Delete old one if exists
For Each ws In Worksheets
    If ws.Name = sUseSheet Then
        Application.DisplayAlerts = False
        Sheets(sUseDataSheet).Delete
        Application.DisplayAlerts = True
    End If
Next
' Create sheet ' After:=Sheets(Sheets.Count)
Sheets.Add(Before:=Sheets(1)).Name = sUseDataSheet
Set ws = ActiveSheetws.Cells(1, 1) = "date"
ws.Cells(1, 2) = "AvgAirTemp"
ws.Cells(1, 3) = "MinAirTemp"
ws.Cells(1, 4) = "MaxAirTemp"
ws.Cells(1, 5) = "PrecipitationMM"
ws.Cells(1, 6) = "SnowDepthMM"
ws.Cells(1, 7) = "AvgWindDirection"
ws.Cells(1, 8) = "AvgWindSpeed"
ws.Cells(1, 9) = "PeakWindGust"
ws.Cells(1, 10) = "AvgSeaLevelAirPressure"
ws.Cells(1, 11) = "SunshineTotalMinutes"' ***
' NOW GET DATA
' ***
' Explains API call technique below.
' https://wellsr.com/vba/2019/excel/vba-http-get-requests-api-serverxmlhttp60/Dim request As MSXML2.ServerXMLHTTP60Dim apiURL As String, requestString As String, header_name As String, sEndDatesEndDate = Format(Now, "YYYY-MM-DD")apiURL = "https://api.meteostat.net/v2/stations/daily?station=72509&start=2020-01-01&end=" & sEndDate
header_name = "x-api-key"
sx_api_key = "8Rwh...get_yer_own_key_Medium_reader:)"Set request = New ServerXMLHTTP60
request.Open "GET", apiURL, Falserequest.setRequestHeader header_name, sx_api_keyrequest.send
response = request.responseTextIf response <> "" Then
    Set jsonObject = jsonConverter.ParseJson(response)
    
    Dim i
    i = 2
    For Each item In jsonObject("data")
        ws.Cells(i, 1) = item("date")
        ws.Cells(i, 2) = item("tavg")
        ws.Cells(i, 3) = item("tmin")
        ws.Cells(i, 4) = item("tmax")
        ws.Cells(i, 5) = item("prcp")
        'ws.Cells(i, 6) = Item("address")("suite") 'if nested
        ws.Cells(i, 6) = item("snow")
        ws.Cells(i, 7) = item("wdir")
        ws.Cells(i, 8) = item("wspd")
        ws.Cells(i, 9) = item("wpgt")
        ws.Cells(i, 10) = item("pres")
        ws.Cells(i, 11) = item("tsun")
        i = i + 1
    Next
        Else
        Debug.Print "Json string returned empty"
    End If
    
Sheets(sThisSheet).SelectEnd Sub

We now have two sheets of data, Covid and Weather.

ORGANIZE

I’ll spare you the code. Next, I copy the Covid data over to the master sheet. I then create VLOOKUPs on the dates to fill in the temperature data. I then have some quick-and-dirty code that deletes outliers.

CHART

I then create three charts, each one pulling from a different date range. For brevity, here is the last which gets the last 30 days.

Range("A1").Select ' make sure chart not activated
sChartName = "CovidChart3"
sTitle = "Track MA Covid with Weather (Last 30 Days)"
vTrendLineVal = 7
' We want to get number of rows of data.  Will use own helper function
vEndRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
vStartRow = vEndRow - 30' DELETE OLD CHART IF EXISTS
NumCharts = ActiveSheet.ChartObjects.Count
    For ic = NumCharts To 1 Step -1
        If ActiveSheet.ChartObjects(ic).Name = sChartName Then
        ActiveSheet.ChartObjects(ic).Delete
        End If
    Next icargL = 41: argT = 1010: argW = 500: argH = 300' CREATE!
DOCAA_FUNC_Chart_Builder ws, ws_name, sChartName, sTitle, vTrendLineVal, vStartRow, vEndRow, argL, argT, argW, argH

This procedure calls a chart creator function that draws the chart exactly the way I want it.

Sub DOCAA_FUNC_Chart_Builder(ws As Worksheet, ws_name, sChartName, sTitle, vTrendLineVal, vStartRow, vEndRow, argL, argT, argW, argH)Range("F2").Select ' we'll move later
ActiveSheet.Shapes.AddChart2(227, xlLine).Select
ActiveChart.Parent.Name = sChartName ' rename chart immediately!
ActiveSheet.ChartObjects(sChartName).Activate ' make sure chart activated
' Position chart
ActiveChart.Parent.Left = argL
ActiveChart.Parent.Top = argT
'Size Chart
ActiveChart.Parent.Width = argW
ActiveChart.Parent.Height = argH' Column map:
' G = Date | H = New Hospitalizations | I = New Positives | J = Average Temp' ***
' ADD DATA TO CHART BY CREATING SERIES FOR EACH
' ***
' FIRST SERIES, Create
ActiveSheet.ChartObjects(sChartName).Activate ' make sure chart activated... etc etc...End Sub

The ease at which you can create trend lines is one of the many built-in features and makes Excel so powerful.

ANNOTATE

Excel doesn’t have a way to save a text box as an image. However, one can create a blank chart, add a text box, then save the chart to get the same result. I’m not using this step in this project (if this story is popular I’ll put it in later).

Sub DOCAA_s25_CHART_CreateExplainerGraphic()' DELETE
NumCharts = ActiveSheet.ChartObjects.Count
    For ic = NumCharts To 1 Step -1
        If ActiveSheet.ChartObjects(ic).Name = "uiExplainer" Then
        ActiveSheet.ChartObjects(ic).Delete
        End If
    Next icRange("B52").Select
' Create Chart
 Dim oChartObj As ChartObject
 Set oChartObj = ActiveSheet.ChartObjects.Add(10, 10, 200, 200)
 oChartObj.Select
 ActiveChart.Parent.Name = "uiExplainer" ' Name Chart
 
 ActiveChart.Parent.Cut
 
 Range("B51").Select
 ActiveSheet.Paste
 
 ActiveSheet.ChartObjects("uiExplainer").Activate
 
 ActiveSheet.Shapes("uiExplainer").Width = 500
 ActiveSheet.Shapes("uiExplainer").Height = 300
 
ActiveSheet.ChartObjects("uiExplainer").Activate
ActiveChart.Shapes.AddTextbox(msoTextOrientationHorizontal, 6, 4.5, 488, 289). _
    Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters.text = _
    Range("slugExplainer").Value
    
iLenText = Len(Range("slugExplainer").Value)
    
ActiveChart.Shapes.Range(Array("TextBox 1")).Select
Selection.ShapeRange(1).TextFrame2.TextRange.Characters(iLenText, 1).Font.Size = 28
Selection.ShapeRange.TextFrame2.TextRange.Font.Size = 40
Selection.ShapeRange.TextFrame2.TextRange.Font.Bold = msoTrue
Selection.ShapeRange.TextFrame2.TextRange.ParagraphFormat.Alignment = _
    msoAlignCenter
Selection.ShapeRange.TextFrame2.VerticalAnchor = msoAnchorMiddle
    With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, iLenText).Font.Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(192, 0, 0)
        .Transparency = 0
        .Solid
    End With
    
Range("H50").Select
            
End Sub

ANIMATE

Here I create GIFs of all the charts

Sub DOCAA_s30_Create_GIFs()Dim objChrt As ChartObject
    Dim MyChart As Chart
    
    myPath = Range("Images_Folder").Value
    xcharts = Split(Range("ChartNames_To_Images").Value, ",")
    
    
        For i = 0 To UBound(xcharts)
       
        sChartName = Trim(xcharts(i))
        sChartNamnGIF = sChartName & ".gif"
        
        Set objChrt = ActiveSheet.ChartObjects(sChartName)
        Set MyChart = objChrt.Chart
        
        On Error Resume Next
        Kill myPath & "\" & sChartNameGIF
        On Error GoTo 0
        
        MyChart.Export Filename:=myPath & "\Chart_" & Trim(Str(i + 1)) & ".gif", FilterName:="GIF"
        
        NextEnd Sub

Then I call Imagemagick’s “convert.exe” command-line app to create the animated GIF. Libraries for creating GIFs on PCs are limited. If I want to create something sophisticated I’ll upload my separate GIFs or PNGs and use an on-line GIF maker like EZGif.com.

Sub DOCAA_s35_Create_AnimatedGIF()
' Example:
'./convert -delay 200 -loop 0 Picture*.gif animate4.gifsPath = Range("Images_Folder").Value
sCommand = sPath & "\" & "convert "
sParams = "-delay " & Range("ChartNames_To_Images").Value & " -loop 0 "sFiles = Range("Images_Folder").Value & "\chart_*.gif "
sTarget = sPath & "\" & Range("slugAnimatedGIFName").ValuesRunString = sCommand & sParams & sFiles & sTarget
Debug.Print sRunStringSet WshShell = CreateObject("WScript.Shell")
WshShell.Run sRunString, 0
Set WshShell = NothingEnd Sub

BONUS

I shell out to WinSCP to upload (update) the images on any website.

Sub DOCAA_s40_uploadBySFTP()
' I used WinSCP Session | Generate Session URL/Code... to figure these settings
' Put all commands for after host connection in heresScriptFile = "C:\Files2020_Analytics\Excel\DOCAA\HTMLPages\WinSCP_Script.txt"
' saves to:
' https://maxdatabook.com/staticpages/docaa_example01.htmlsWinSCP = "C:\Program Files (x86)\WinSCP\WinSCP.exe"
sWinSCPGeneratedScript = " /ini=nul /script=" & Chr(34) & sScriptFile & Chr(34)
sCmd = Chr(34) & sWinSCP & Chr(34) & sWinSCPGeneratedScriptDebug.Print sCmdDim script As Object: Set script = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1'Execute script
script.Run sCmd, windowStyle, waitOnReturn
        
End Sub

CONCLUSION

Using Excel, we can automate the creation of charts, and explainer slides, from which we can use separately, or combine into an animated GIF. We can then update our website with the updated charts.

I’m an independent software consultant/developer and can be reached at maxdatabook.com