Contextures

Home > Pivot > Macros > Unpivot

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. If you want manually unpivot the source data, go to the Fix pivot table source data page.

NOTE: This technique uses the old Multiple Consolidation Ranges feature, which has a 256 character limit per cell. If your table has cells with long entries, they might be cut off.

source data multiple month columns

Intro - 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 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.

Each row shows Lamps sales, East Region, for Sam, for one month, from January to December

source data single month columns

Preparation Steps

Before you use the Excel UnPivot macro, make sure your data meets these 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 The Labels columns are the ones that you would usually use in a pivot table's Row, Column or Filter area, like Product, Region and Rep, shown below
  • All the "Value" columns are at the right. like the Month column, shown below
Text Limit

This unpivot technique uses the old Multiple Consolidation Ranges feature, which has a 256 character limit per cell. The macro temporarily combines cell text from the Labels columns. That could result in text strings that are over 256 characters.

To check your data, download the Unpivot Text Length sample file, and use its macro, named UnpivotDataCheckLen. There are notes about that macro in the Macro 3 section below.

source data multiple month columns

Choose an Unpivot Macro

There are 2 macros in the sample file:

  • Macro 1: UnpivotData
  • Macro 2: UnpivotDataSelSheet

Both macros start with the following steps:

  • Show 2 messages where you will enter information
  • Make a copy of the active sheet, in a new workbook.
  • Create the "unpivotted" data in that new workbook -- your original data will not be altered.

The difference between the 2 macros occurs at the very end:

  • Macro 1: Data stays in the new workbook, which stays open (unsaved)
  • Macro 2: Data is copied to active workbook. New workbook is closed, without saving

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.

Use the Excel UnPivot Macro

There are 3 main steps when you run either of the Unpivot macros:

  • Select a Split Character
  • Enter the Number of Label Columns
  • Fix Headings in New Data

The details for these 3 steps are shown below.

NOTE
  • After you run one of the macros, the new data is not connected to the original source data.
  • The new data is meant to be a replacement for the original data. Build a new pivot table from the new data.
  • If the original source data is changed later, the new "unpivotted" data will not change.

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

Fix Headings in 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 1 Code

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

Excel UnPivot Macro 2 Code

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.

Top of Macro Additions

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)

End of Macro Additions

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.

  • First, the ListNew variable is set, as the table with the new data
  • The results sheet is cleared.
  • The table with the new data is copied to the results sheet
  • After that, the new workbook is closed, without saving it
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.

wsResult.Activate

Macro 3 - Check Text Length

The unpivot macros on this page use the old Multiple Consolidation Ranges feature, which has a 256 character limit per cell. If your table has cells with long entries, they might be cut off.

To test your data, download the Unpivot Text Length sample file, and use its macro, named UnpivotDataCheckLen.

In that macro:

  1. A column is added, to calculate the length of the combined text, using the LEN function
  2. The maximum value in that column is calculated, using the MAX function
  3. If the max is greater than the 256 character limit, a warning message is shown
  4. Click Yes, to continue, or click No the end the macro

warning message for text over 256 characters

'check combined text length
With wsNew
  .Cells(RowStart, ColEnd + 1).Value = "Len"
  .Cells(RowStart + 1, ColEnd + 1) _
    .FormulaR1C1 = "=LEN([@Column1])"
End With

With myList.DataBodyRange
  Set rngLen = .Columns(.Columns.Count)
End With
MaxLen = Application.WorksheetFunction.Max(rngLen)

If MaxLen > 256 Then
  lRspLen = MsgBox("Text over 256 characters." _
    & vbCrLf & "Text will be lost." _
    & vbCrLf & "Continue?", _
    vbCritical + vbYesNo, "Text Too Long")
  If lRspLen <> vbYes Then
    msgEnd = "Unpivot macro cancelled" _
      & vbCrLf _
      & "See Len column for character counts"
    GoTo exitHandler
  End If
End If

Download the Sample File

Unpivot Macros: 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.

Unpivot Text Length: To see if your data will be over the 256 character limit, use the macro in the Unpivot Text Length sample file. The zipped file is in xlsm format, and be sure to enable macros when opening the file, if you want to test the code.

More Tutorials

Fix Pivot Table Source Data

Unpivot, Power Query

Pivot Table Layout VBA

FAQs - Pivot Tables

Pivot Table Intro

Summary Functions

Clear Old Items in Pivot Table

Last updated: March 8, 2023 7:29 PM