Contextures

Excel UnPivot Macro

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.

Unpivot Pivot Table Source Data

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.

source data multiple month columns

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.

source data single month columns

Using the Excel UnPivot Macro

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.

Before you use the Excel UnPivot macro, make sure your data meets the requirements:

  • The data is in a named Excel table (on the Insert tab, click Table). Read more about tables here.
  • All the "Label" columns are at the left, and values are at the right. The Labels columns are the ones that you would usually use in a pivot table's Row, Column or Filter area.

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.

Select a Split Character

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.

enter a separator character

The default character is the Pipe - |

labels combined in one column

Enter the Number of Label Columns

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.

enter the number of label columns

Unpivotted Data

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.

change headings in unpivotted data

Excel UnPivot Macro Code

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.

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 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
Application.ScreenUpdating = False
Application.EnableEvents = False
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", "|")

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

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 = "=CONCATENATE("
For iCol = 1 To NumCols
  myFormula = myFormula & "[@" & myList.HeaderRowRange(1, iCol).Value _
    & "]," & Chr(34) & mySep & Chr(34) & ","
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
  .PivotFields("Row").Orientation = xlHidden
  .PivotFields("Column").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

MsgBox "Data is unpivoted in new workbook" _
  & vbCrLf _
  & "Change headings and copy to original workbook"

exitHandler:
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Exit Sub

errHandler:
  MsgBox "Could not unpivot the data"
  Resume exitHandler

End Sub

Download the Sample File

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.

Get All the Excel News

For regular Excel news, tips and videos, please sign up for the Contextures Excel newsletter. Your email address will never be shared with anyone else.

Search Contextures

Search Contextures Sites

More Tutorials

Fix Pivot Table Source Data

Pivot Table Layout VBA

FAQs - Pivot Tables

Pivot Table Intro

Summary Functions

Clear Old Items in Pivot Table

Search Contextures Sites

 

pivot power free

 

 

 

 

Excel Data Entry Popup List

 

 

 

pivot power free

 

Last updated: January 30, 2017 11:10 AM
Contextures RSS Feed