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 macro 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.
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.
Make sure your data meets the requirements:
The macro will make a copy of the active sheet, in a new workbook. Then, it will create the "unpivotted" data in that new workbook. Your original data will not be altered.
NOTE: If the original source data is changed later, the new "unpivotted" data will not change. It will not hae any connection to the original data. It is meant to be a replacement for the original data.
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.
To use the 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
To test the Excel unpivot macro code, you can download the sample file. The zipped file is in xlsm format, and be sure to enable macros when opening the file.
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.
Search Contextures Sites
Last updated: May 2, 2018 9:22 AM
Contextures RSS Feed