Convert a cross-tab to a data table

Tested in Excel 365 (16.8730.2046) 64-bit. All links open in new tab.

This is useful when you have a cross-tab and you need the data from which it was derived.

Of course, you can easily unpivot using PowerPivot, see here how.

 
 
  1. Public Sub ConvertTableToData()
  2.     Dim LastRow, xLastCol, LastCol
  3.     Dim currRow, currRowValue
  4.     Dim i, j, DataSheet, FinalSheet
  5.     Dim HeaderArray(), CountArray()
  6.    
  7.     DataSheet = ActiveSheet.Name
  8.     FinalSheet = "Data"
  9.    
  10.     ' delete existing output sheet, if any
  11.    Application.DisplayAlerts = False
  12.     If SheetExists(FinalSheet) Then Sheets(FinalSheet).Delete
  13.     Application.DisplayAlerts = True
  14.    
  15.     'creates new sheet with header
  16.    Sheets.Add After:=Sheets(Sheets.Count)
  17.     ActiveSheet.Name = FinalSheet
  18.     Cells(1, 1).Value = "Rows"
  19.     Cells(1, 2).Value = "Cols"
  20.     Cells(1, 3).Value = "Value"
  21.    
  22.     ' get the pasting position
  23.    Sheets(DataSheet).Activate
  24.     LastRow = Range("A" & Rows.Count).End(xlUp).Row
  25.     LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
  26.     xLastCol = LastCol - 1
  27.    
  28.     HeaderArray = Range(Cells(1, 2), Cells(1, LastCol))
  29.    
  30.     currRow = 2
  31.     For i = 2 To LastRow
  32.         CountArray = Range(Cells(i, 2), Cells(i, LastCol))
  33.         currRowValue = Cells(i, 1).Value
  34.         With Sheets(FinalSheet)
  35.             'paste-transpose the header and the data
  36.            .Range(.Cells(currRow, 2), .Cells(currRow + xLastCol - 1, 2)).Value = Application.Transpose(HeaderArray)
  37.             .Range(.Cells(currRow, 3), .Cells(currRow + xLastCol - 1, 3)).Value = Application.Transpose(CountArray)
  38.             'fill in the rows with the row label
  39.            For j = currRow To currRow + xLastCol - 1
  40.                 .Cells(j, 1).Value = currRowValue
  41.             Next j
  42.         End With
  43.         currRow = currRow + xLastCol
  44.     Next i
  45.    
  46.     MsgBox "Done!"
  47. End Sub

SheetExists function is here

You can use this file to test the code.

Add a Comment

Your email address will not be published.

This site uses Akismet to reduce spam. Learn how your comment data is processed.