Use this Excel unpivot macro to fix pivot table source data that has amounts in multiple columns instead of a single column.
NOTE: If you want manually unpivot the source data, go to the Fix pivot table source data page.
If pivot table source data is set up like the example shown below, with amounts split into multiple columns, it will be difficult to build a flexible pivot table. Each month will be a separate field in the pivot table, and you won't see an annual total automatically.
The Excel Unpivot macros on this page will restructure this type of data, and put all the amounts into a single column, with the month names in another column.
As you can see in the screen shots, the first row from the table above has been broken into 12 rows, in the "unpivotted" table below.
Before you use the Excel UnPivot macro, make sure your data meets these requirements:
There are 2 macros in the sample file:
Both macros start with the following steps:
The difference between the 2 macros occurs at the very end:
The unpivot macro code is in the next section, and you can go to the download section to get a file that contains the code, and a sample table.
There are 3 main steps when you run either of the Unpivot macros:
The details for these 3 steps are shown below.
While the macro runs, it temporarily combines the data from the Label columns, with a separator character between them. The macro will prompt you to enter a separator character that is not used in your Label column.
The default character is the Pipe - |
Next, another input box will appear, and ask you to enter the number of Label columns in your table. The default setting in that box is 1, and you can replace that with the number that you need.
After the macro finishes running, the active sheet will contain your unpivotted data. The original headings are on the Label columns, and you can type new headings for the Column and Value headings.
Then, copy the sheet or the data back into your original workbook, and you can create a pivot table from the unpivotted data.
This macro, UnpivotData, unpivots the data, and leaves it in a new workbook. From there, you can copy the unpivotted data to a different workbook, or save the new workbook, with the data in it.
NOTE: If you want the data to go to a specific sheet in the original workbook, go to the Macro 2 Code
To use this Excel Unpivot macro, copy the following code into a regular code module. There are instructions at this link, if you need the steps for that. Thank you to Jerry N for suggesting that the & operator be used, instead of CONCATENATE -- that will prevent problems in non-English versions of Excel.
Sub UnpivotData() 'downloaded from contextures.com 'code to unpivot named Excel table 'uses first table on the sheet, 'if more than one table Dim myList As ListObject Dim NumCols As Long Dim PT01 As PivotTable Dim wbA As Workbook Dim wbNew As Workbook Dim wsA As Worksheet Dim wsNew As Worksheet Dim wsPT As Worksheet Dim wsNewData As Worksheet Dim myData As Range Dim mySep As String Dim myJoin As String Dim ColStart As Long Dim ColEnd As Long Dim ColCount As Long Dim RowStart As Long Dim RowEnd As Long Dim RowCount As Long Dim DataStart As Range Dim DataEnd As Range Dim iCol As Long Dim myFormula As String Dim msgSep As String Dim msgLabels As String Dim msgEnd As String On Error GoTo errHandler Set wsA = ActiveSheet Set wbA = ActiveWorkbook msgSep = "The macro will temporarily combine the labels," msgSep = msgSep & vbCrLf msgSep = msgSep & "and then split them." msgSep = msgSep & vbCrLf msgSep = msgSep & vbCrLf msgSep = msgSep & "Please enter a single character" msgSep = msgSep & vbCrLf msgSep = msgSep & "that's not in your labels," msgSep = msgSep & vbCrLf msgSep = msgSep & "such as | (default in box below)" mySep = InputBox(msgSep, "Split Character", "|") 'join operator for Excel formulas myJoin = "&" Select Case Len(mySep) Case 0 MsgBox "No split character was entered -- cancelling macro" GoTo exitHandler Case Is > 1 MsgBox "Only one character is allowed for splitting -- cancelling macro" GoTo exitHandler Case Else 'do nothing End Select msgLabels = "How many columns, at the left side" msgLabels = msgLabels & vbCrLf msgLabels = msgLabels & "of the table, contain labels?" msgLabels = msgLabels & vbCrLf msgLabels = msgLabels & vbCrLf msgLabels = msgLabels & "Remaining columns, at the right," msgLabels = msgLabels & vbCrLf msgLabels = msgLabels & "will be unpivoted" On Error Resume Next NumCols = 0 NumCols = CLng(InputBox(msgLabels, "Label Columns", 1)) On Error GoTo errHandler Select Case NumCols Case 0 MsgBox "No columns entered -- cancelling macro" GoTo exitHandler Case Else 'do nothing End Select Application.ScreenUpdating = False Application.EnableEvents = False wsA.Copy Set wbNew = ActiveWorkbook Set wsNew = ActiveSheet Set myList = wsNew.ListObjects(1) With myList ColStart = .HeaderRowRange.Columns(1).Column RowStart = .HeaderRowRange.Columns(1).Row RowCount = .DataBodyRange.Rows.Count RowEnd = .DataBodyRange.Rows(RowCount).Row 'insert column for the combined labels wsNew.Columns(NumCols + ColStart).Insert Shift:=xlToRight ColCount = .DataBodyRange.Columns.Count ColEnd = .DataBodyRange.Columns(ColCount).Column End With 'build formula to combine labels myFormula = "=(" For iCol = 1 To NumCols myFormula = myFormula & "[@" _ & myList.HeaderRowRange(1, iCol).Value _ & "]" & myJoin & Chr(34) _ & mySep & Chr(34) & myJoin Next iCol myFormula = Left(myFormula, Len(myFormula) - 5) myFormula = myFormula & ")" With myList .DataBodyRange.Cells(1, NumCols + 1).Formula = myFormula .DataBodyRange.Columns(NumCols + 1).Value _ = .DataBodyRange.Columns(NumCols + 1).Value Set DataStart = .HeaderRowRange(1, NumCols + 1) End With Set DataEnd = wsNew.Cells(RowEnd, ColEnd) Set myData = wsNew.Range(DataStart, DataEnd) 'create multiple consolidation pivot table wbNew.PivotCaches.Create(SourceType:=xlConsolidation, _ SourceData:=wsA.Name & "!" _ & myData.Address(, , xlR1C1)).CreatePivotTable _ TableDestination:="", _ TableName:="PT1" Set wsPT = ActiveSheet Set PT01 = wsPT.PivotTables(1) With PT01 .ColumnFields(1).Orientation = xlHidden .RowFields(1).Orientation = xlHidden End With 'move combined labels to right, and split 'then move back to left side of table wsPT.Range("A2").ShowDetail = True Set wsNewData = ActiveSheet With wsNewData .Columns("B:C").Cut .Columns("A:B").Insert Shift:=xlToRight .Columns("C:C").TextToColumns _ Destination:=.Range("C1"), _ DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, _ ConsecutiveDelimiter:=False, _ Tab:=False, _ Semicolon:=False, _ Comma:=False, _ Space:=False, _ Other:=True, _ OtherChar:=mySep .Range(.Cells(1, 3), .Cells(1, NumCols + 2)) _ .EntireColumn.Cut .Range(.Cells(1, 1), .Cells(1, NumCols)) _ .EntireColumn.Insert Shift:=xlToRight End With With myList.HeaderRowRange .Resize(, NumCols).Copy _ Destination:=wsNewData.Cells(1, 1) End With On Error Resume Next wsNewData.Cells(1, NumCols + 1).Select msgEnd = "Data is unpivoted in new workbook" _ & vbCrLf _ & "Change headings and copy to original workbook" exitHandler: Application.ScreenUpdating = True MsgBox msgEnd Application.EnableEvents = True Exit Sub errHandler: msgEnd = "Could not unpivot the data" Resume exitHandler End Sub
This macro, UnpivotDataSelSheet, unpivots the data, and puts it on a specific sheet in the active workbook. On that sheet, you can fix the column headings in the new data
Most of the code for this macro is the same as the Macro 1 code, so the entire procedure won't be repeated here. There are additional lines near the top of the macro, and near the end.
The full code for the UnpivotDataSelSheet macro is in the sample workbook, available in the download section below.
There are 3 new variables defined in this macro. For the strRes variable, the sheet name where the data should be copied, is entered:
Dim wsResult As Worksheet Dim ListNew As ListObject Dim strRes As String strRes = "Fixed" 'sheet for results
A few lines further down, after the wbA variable is set as the active workbook, the results sheet variable is set:
Set wsResult = wbA.Sheets(strRes)
Near the end of the macro, after the source data table headings have been copied to the new data, there are a few new lines of code.
Set ListNew = wsNewData.ListObjects(1) wsResult.Cells.Clear ListNew.Range.EntireColumn.Copy _ Destination:=wsResult.Cells(1, 1) wbNew.Close SaveChanges:=False
The text for the end message is different in this macro, and shows the results sheet name.
msgEnd = "Unpivoted data is on " _ & strRes & " sheet" _ & vbCrLf _ & "You can fix headings there"
And finally, the results sheet is activated.
To test the Excel unpivot macro code, you can download the sample file. The sample file contains both macros, and a sample table for testing.
The zipped file is in xlsm format, and be sure to enable macros when opening the file, if you want to test the code.
Don't miss my latest Excel tips and videos! Click OK, to get my weekly newsletter with Excel tips, and links to other Excel news and resources.
Last updated: September 3, 2019 3:48 PM
Contextures RSS Feed