Data + Science

4/7/2014
Excel VBA Macro to Prepare Data for Sankey in Tableau

I have had a number of emails about building sankey diagrams and sankey-style slopegraphs in Tableau based on the instructions that I posted here. Even though it's fairly quick and easy to build in Tableau it does require putting the data into a certain format before importing into Tableau. I'm not one for repetitive tasks and so I decided to write a quick VBA Macro in Excel to prepare the data for immediate import into Tableau.

Sample data:

In this example there are 5 rows of data with 2 rankings, position 1 and position 2 followed by some random fields of junk data. To create the curves in Tableau I use 49 points, which means every row of data needs to be converted into 49 rows of data. In addition, there needs to be an additional column t with values ranging from -6 to 6 in increments of .25 (which is 49 values). For example, the State of America Ranking has 50 curves, one for each state totalling 2,450 rows of data. The Redesign of My Monthly Energy Bill from Duke Energy has 100 curves in the sankey diagram, 1 for each % up to 100%, which totals 4,900 rows.

The VBA Macro below will do this transformation automatically so that the data can be immediately imported into Tableau. I included an option for data with and without a header row. Here is the macro:


Sub PrepareDataCurve()

Dim j As Long, r As Range, h As Integer, LastColumn As Long, LastRow As Long, k As Integer, i As Integer, l As Integer, t As Double
j = 49
h = MsgBox(Prompt:="Is there a header row?", _
            Buttons:=vbYesNoCancel, Title:="Header Row?")
If h = vbYes Then
        Set r = Range("A2")
        LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
    ElseIf h = vbNo Then
       Set r = Range("A1")
       LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Else
        Exit Sub
End If

Do
Range(r.Offset(0, 0), r.Offset(0, 0)).EntireRow.Copy
Range(r.Offset(1, 0), r.Offset(j - 1, 0)).EntireRow.Insert
Set r = Cells(r.Row + j, 1)
If r.Offset(1, 0) = "" Then
        Range(r.Offset(0, 0), r.Offset(0, 0)).EntireRow.Copy
        Range(r.Offset(1, 0), r.Offset(j - 1, 0)).EntireRow.Insert
        Exit Do
    Else
End If
Loop

LastColumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If h = vbYes Then
        Cells(1, LastColumn).Value = "t"
        l = 1
    ElseIf h = vbNo Then
        l = 0
End If
    
For k = 0 To LastRow - 1
    t = -6
    For i = 1 To j
        Cells(i + (k * j) + l, LastColumn) = t
        t = t + (12 / (j - 1))
    Next i
Next k

End Sub

After running this macro there will be 49 rows for each original row of data and a new column for t with the values populated. Download the sample data and macro here.

I hope you find this helpful. If you have any questions feel free to email me at Jeff@DataPlusScience.com

Jeffrey A. Shaffer

Follow on Twitter @HighVizAbility