Howdy folks. Jeff Pivot…err…Weir here again.
Recently Ken Puls did a handy post on how to unpivot data using PowerQuery. Jan Karel commented that you can do this using Multiple Consolidation Ranges. That’s true, but what I like about the PowerQuery approach is that you can translate the currently selected columns into attribute-value pairs, combined with the rest of the values in each row. That is, you can have multiple hierarchical columns down the left of your CrossTab as well as the column headers across the top that you want to amalgamate. Which is great if you have a crosstab like this:
Whereas the Multiple Consolidation trick only handles one column down the left out of the box.
Mike Alexander posted a great bacon-tasting morsel of a trick to get around that issue way back in 2009 when he used to blog. He simply concatenating all the non-column-oriented fields into one dimension field into one temporary column. Check out his post Transposing a Dataset with a PivotTable. But as commenter dermotb said…it’s like a magic spell that you have to write down somewhere, and try to find when you need it, because it’s complex. (I love Mike’s reply to that: Come on. Excel is full of magic syntax, mystical hot keys, and vba voodoo that requires some level of memorizing steps. That’s why I can make a living peddling “tips and tricks”.)
Another problem with the Multiple Consolidation trick is that you might well end up with more data than fits in your sheet, by the time you flatten it out. Especially in old Excel. Because the number of rows you end up with in a flat file is the number of rows you start off with times the number of columns that you’re going to amalgamate. So for say a time-series dataset that covers quite a few items and a reasonable period of time, you could be in trouble.
So a while ago I had a crack at writing a SQL routine that unpivots by doing lots of UNION ALL joins, and writes the data directly to a PivotTable. The UNION ALLs are required because the pidgin English version of SQL that Excel speaks (and Access too, I guess) doesn’t have a UNPIVOT command.
I struck a few hurdles along the way. For instance, it turns out that the Microsoft JET/ACE Database engine has a hard limit of 50 ‘UNION ALL’ clauses, which you will soon exceed if you have a big crosstab with multiple columns down the left. I found a great thread over at MrExcel at which Fazza overcame this hard limit by creating sub-blocks of UNION ALL statements, then stiching them all together with another UNION ALL. Another problem is that SQL didn’t like dates (and sometimes numbers) in the headers. So I turn them into text with an apostrophe.
And another thing I do is save a temp version of the file somewhere, and then query that temp version rather than querying the open workbook. Even though the Memory Leak issue that this avoids has been largely fixed in New Excel, I still found that querying the open book was causing grief occasionally.
Anyway, here’s the result. I’ve turned it into a function, and you can pre-specify inputs if you like. Otherwise you’ll be prompted for the following:
…and then you’ll get a Pivot:
Take it for a spin, let me know of any issues in the comments. Note that I’ve tried to code it to handle Excel 2003 and earlier, but I don’t have old Excel anymore so couldn’t test it. In fact, that’s why the TabularLayout sub is separate – I had to put it in a subroutine because if someone has ‘old’ Excel then the main function wouldn’t compile.
Cheers
Jeff
Sub CallUnPivotBySQL()
UnPivotBySQL
End Sub
Function UnPivotBySQL(Optional rngCrosstab As Range, _
Optional rngLeftHeaders As Range, _
Optional rngRightHeaders As Range, _
Optional strCrosstabName As String) As Boolean
' Description: Turns a crosstab file into a flatfile (equivalent to the 'UNPIVOT' command in SQL Server)
' and makes a pivottable out of it. Basically it rotates columns of a table-valued expression
' into column values. Base code from Fazza at MR EXCEL forum:
' http://www.mrexcel.com/forum/showthread.php?315768-Creating-a-pivot-table-with-multiple-sheets
' Programmer: Jeff Weir
' Contact: weir.jeff@gmail.com or heavydutydata@gmail.com
' Name/Version: Date: Ini: Modification:
' UnPivotBySQL V1 20131119 JSW Original development
' Inputs: Range of the entile crosstab
' Range of columns down the left that WON'T be normalized
' Range of columns down the right that WILL be normalize
' String containing the name to give columns that will be normalized
' Outputs: A pivottable of the input data on a new worksheet.
' Example:
' It takes a crosstabulated table that looks like this:
' Country Sector 1990 1991 ... 2009
' =============================================================================
' Australia Energy 290,872 296,887 ... 417,355
' New Zealand Energy 23,915 25,738 ... 31,361
' United States Energy 5,254,607 5,357,253 ... 5,751,106
' Australia Manufacturing 35,648 35,207 ... 44,514
' New Zealand Manufacturing 4,389 4,845 ... 4,907
' United States Manufacturing 852,424 837,828 ... 735,902
' Australia Transport 62,121 61,504 ... 83,645
' New Zealand Transport 8,679 8,696 ... 13,783
' United States Transport 1,484,909 1,447,234 ... 1,722,501
' And it returns the same data in a recordset organised like this:
' Country Sector Year Value
' ====================================================
' Australia Energy 1990 290,872
' New Zealand Energy 1990 23,915
' United States Energy 1990 5,254,607
' Australia Manufacturing 1990 35,648
' New Zealand Manufacturing 1990 4,389
' United States Manufacturing 1990 852,424
' Australia Transport 1990 62,121
' New Zealand Transport 1990 8,679
' United States Transport 1990 1,484,909
' Australia Energy 1991 296,887
' New Zealand Energy 1991 25,738
' United States Energy 1991 5,357,253
' Australia Manufacturing 1991 35,207
' New Zealand Manufacturing 1991 4,845
' United States Manufacturing 1991 837,828
' Australia Transport 1991 61,504
' New Zealand Transport 1991 8,696
' United States Transport 1991 1,447,234
' ... ... ... ...
' ... ... ... ...
' ... ... ... ...
' Australia Energy 2009 417,355
' New Zealand Energy 2009 31,361
' United States Energy 2009 5,751,106
' Australia Manufacturing 2009 44,514
' New Zealand Manufacturing 2009 4,907
' United States Manufacturing 2009 735,902
' Australia Transport 2009 83,645
' New Zealand Transport 2009 13,783
' United States Transport 2009 1,722,501
' Base code from Fazza at MR EXCEL:
' http://www.mrexcel.com/forum/showthread.php?315768-Creating-a-pivot-table-with-multiple-sheets
' Fazza's code base was perfect for this, given that:
' A) unwinding a crosstab requires heavy use of 'UNION ALL' in absence of an 'UNPIVOT' command,
' B) The Microsoft JET/ACE Database engine has a hard limit of 50 'UNION ALL' clauses, but Fazza's
' code gets around this by creating sublocks of up to 25 SELECT/UNION ALL statements, and
' then unioning these.
' C) unwinding a BIG crosstab by using the 'reverse pivot' trick via multiple consolidation ranges
' might well result in more data that the worksheet can handle.
'
Const lngMAX_UNIONS As Long = 25
Dim i As Long, j As Long
Dim arSQL() As String
Dim arTemp() As String
Dim sTempFilePath As String
Dim objPivotCache As PivotCache
Dim objRS As Object
Dim oConn As Object
Dim sConnection As String
Dim wksNew As Worksheet
Dim cell As Range
Dim strLeftHeaders As String
Dim wksSource As Worksheet
Dim pt As PivotTable
Dim rngCurrentHeader As Range
Const Success As Boolean = True
Const Failure As Boolean = False
UnPivotBySQL = Failure
If ActiveWorkbook.Path <> "" Then 'can only proceed if the workbook has been saved somewhere
'Identify where the ENTIRE crosstab table is
If rngCrosstab Is Nothing Then
On Error Resume Next
Set rngCrosstab = Application.InputBox( _
Title:="Please select the ENTIRE crosstab", _
prompt:="Please select the ENTIRE crosstab that you want to turn into a flat file", _
Type:=8, Default:=Selection.CurrentRegion.Address)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
rngCrosstab.Parent.Activate
rngCrosstab.Cells(1, 1).Select 'Returns them to the top left of the source table for convenience
End If
'Identify range containing columns of interest running down the table
If rngLeftHeaders Is Nothing Then
On Error Resume Next
Set rngLeftHeaders = Application.InputBox( _
Title:="Select the column HEADERS from the LEFT of the table that WON'T be aggregated", _
prompt:="Select the column HEADERS from the LEFT of the table that won't be aggregated", _
Default:=Selection.Address, Type:=8)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
Set rngLeftHeaders = rngLeftHeaders.Resize(1, rngLeftHeaders.Columns.Count) 'just in case they selected the entire column
rngLeftHeaders.Cells(1, rngLeftHeaders.Columns.Count + 1).Select 'Returns them to the right of the range they just selected
End If
If rngRightHeaders Is Nothing Then
'Identify range containing data and cross-tab headers running across the table
On Error Resume Next
Set rngRightHeaders = Application.InputBox( _
Title:="Select the column HEADERS from the RIGHT of the table that WILL be aggregated", _
prompt:="Select the column HEADERS from the RIGHT of the table that WILL be aggregated", _
Default:=Selection.Address, _
Type:=8)
If Err.Number <> 0 Then
On Error GoTo errhandler
Err.Raise 999
Else: On Error GoTo errhandler
End If
Set rngRightHeaders = rngRightHeaders.Resize(1, rngRightHeaders.Columns.Count) 'just in case they selected the entire column
rngCrosstab.Cells(1, 1).Select 'Returns them to the top left of the source table for convenience
End If
If strCrosstabName = "" Then
'Get the field name for the columns being consolidated e.g. 'Country' or 'Project'. note that reserved SQL words like 'Date' cannot be used
strCrosstabName = Application.InputBox( _
Title:="What name do you want to give the data field being aggregated?", _
prompt:="What name do you want to give the data field being aggregated? e.g. 'Date', 'Country', etc.", _
Default:="Date", _
Type:=2)
If strCrosstabName = "False" Then Err.Raise 999
End If
Application.ScreenUpdating = False
Set wksSource = rngLeftHeaders.Parent
'Build part of SQL Statement that deals with 'static' columns i.e. the ones down the left
For Each cell In rngLeftHeaders
'For some reason this approach doesn't like columns with numeric headers.
' My solution in the below line is to prefix any numeric characters with
' an apostrophe to render them non-numeric, and restore them back to numeric
' after the query has run
If IsNumeric(cell) Or IsDate(cell) Then cell.Value = "'" & cell.Value
strLeftHeaders = strLeftHeaders & "[" & cell.Value & "], "
Next cell
ReDim arTemp(1 To lngMAX_UNIONS) 'currently 25 as per declaration at top of module
ReDim arSQL(1 To (rngRightHeaders.Count - 1) \ lngMAX_UNIONS + 1)
For i = LBound(arSQL) To UBound(arSQL) - 1
For j = LBound(arTemp) To UBound(arTemp)
Set rngCurrentHeader = rngRightHeaders(1, (i - 1) * lngMAX_UNIONS + j)
arTemp(j) = "SELECT " & strLeftHeaders & "[" & rngCurrentHeader.Value & "] AS Total, '" & rngCurrentHeader.Value & "' AS [" & strCrosstabName & "] FROM [" & rngCurrentHeader.Parent.Name & "$" & Replace(rngCrosstab.Address, "$", "") & "]"
If IsNumeric(rngCurrentHeader) Or IsDate(rngCurrentHeader) Then rngCurrentHeader.Value = "'" & rngCurrentHeader.Value 'As per above, can't have numeric headers
Next j
arSQL(i) = "(" & Join$(arTemp, vbCr & "UNION ALL ") & ")"
Next i
ReDim arTemp(1 To rngRightHeaders.Count - (i - 1) * lngMAX_UNIONS)
For j = LBound(arTemp) To UBound(arTemp)
Set rngCurrentHeader = rngRightHeaders(1, (i - 1) * lngMAX_UNIONS + j)
arTemp(j) = "SELECT " & strLeftHeaders & "[" & rngCurrentHeader.Value & "] AS Total, '" & rngCurrentHeader.Value & "' AS [" & strCrosstabName & "] FROM [" & rngCurrentHeader.Parent.Name & "$" & Replace(rngCrosstab.Address, "$", "") & "]"
If IsNumeric(rngCurrentHeader) Or IsDate(rngCurrentHeader) Then rngCurrentHeader.Value = "'" & rngCurrentHeader.Value 'As per above, can't have numeric headers
Next j
arSQL(i) = "(" & Join$(arTemp, vbCr & "UNION ALL ") & ")"
'Debug.Print Join$(arSQL, vbCr & "UNION ALL" & vbCr)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' When using ADO with Excel data, there is a documented bug
' causing a memory leak unless the data is in a different
' workbook from the ADO workbook.
' http://support.microsoft.com/kb/319998
' So the work-around is to save a temp version somewhere else,
' then pull the data from the temp version, then delete the
' temp copy
sTempFilePath = ActiveWorkbook.Path
sTempFilePath = sTempFilePath & "\" & "TempFile_" & Format(Time(), "hhmmss") & ".xlsm"
ActiveWorkbook.SaveCopyAs sTempFilePath
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Application.Version >= 12 Then
'use ACE provider connection string
sConnection = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & sTempFilePath & ";Extended Properties=""Excel 12.0;"""
Else
'use JET provider connection string
sConnection = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & sTempFilePath & ";Extended Properties=""Excel 8.0;"""
End If
Set objRS = CreateObject("ADODB.Recordset")
Set oConn = CreateObject("ADODB.Connection")
' Open the ADO connection to our temp Excel workbook
oConn.Open sConnection
' Open the recordset as a result of executing the SQL query
objRS.Open Source:=Join$(arSQL, vbCr & "UNION ALL" & vbCr), ActiveConnection:=oConn, CursorType:=3 'adOpenStatic !!!NOTE!!! we have to use a numerical constant here, because as we are using late binding Excel doesn't have a clue what 'adOpenStatic' means
Set objPivotCache = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set objPivotCache.Recordset = objRS
Set objRS = Nothing
Set wksNew = Sheets.Add
Set pt = objPivotCache.CreatePivotTable(TableDestination:=wksNew.Range("A3"))
Set objPivotCache = Nothing
'Turn any numerical headings back to numbers by effectively removing any apostrophes in front
For Each cell In rngLeftHeaders
If IsNumeric(cell) Or IsDate(cell) Then cell.Value = cell.Value
Next cell
For Each cell In rngRightHeaders
If IsNumeric(cell) Or IsDate(cell) Then cell.Value = cell.Value
Next cell
With pt
.ManualUpdate = True 'stops the pt refreshing while we make chages to it.
If Application.Version >= 14 Then TabularLayout pt
For Each cell In rngLeftHeaders
With .PivotFields(cell.Value)
.Orientation = xlRowField
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
Next cell
With .PivotFields(strCrosstabName)
.Orientation = xlRowField
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
With .PivotFields("Total")
.Orientation = xlDataField
.Function = xlSum
End With
.ManualUpdate = False
End With
UnPivotBySQL = Success
Else: MsgBox "You must first save the workbook for this code to work."
End If
errhandler:
If Err.Number <> 0 Then
Select Case Err.Number
Case 999: 'User pushed cancel.
Case Else: MsgBox "Whoops, there was an error: Error#" & Err.Number & vbCrLf & Err.Description _
, vbCritical, "Error", Err.HelpFile, Err.HelpContext
End Select
End If
Application.ScreenUpdating = True
End Function
Private Sub TabularLayout(pt As PivotTable)
With pt
.RepeatAllLabels xlRepeatLabels
.RowAxisLayout xlTabularRow
End With
End Sub