Thread: Macros to change cross tab to flat list table

Hi,

Every week I get a data extract that shows the data in a cross tab format. What I need is to get it into a flat list so that I can pivot it. I'd like one column for the "Week Commencing" and one column for the "forecast" (see attached file). I've tried to run a macros but it get really messy (I'm new to vba). It's quite a large dataset so cutting and pasting won't work. I've attached the file for reference. Appreciate any help.

Cheers,
John

Hi jtd84,

Run this macro on your crosstab table (only once) and see if it puts it in a "flat" table format for you.

Option Explicit

Sub MakeCrossTabATable()
Dim LastRow As Double
Dim LastARow As Double
Dim TopRow As Double
Dim ColCtr As Double
LastARow = Cells(Rows.Count, "A").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:="RepeatData", RefersToR1C1:= _
        "='03.Data Extract Forecast'!R2C1:R" & LastARow & "C12"
ColCtr = 13
    Columns(ColCtr).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Cells(1, "M") = "Date"
    TopRow = Cells(Rows.Count, "M").End(xlUp).Row
    Cells(1, ColCtr + 1).Copy Destination:=Range(Cells(TopRow + 1, "M"), Cells(LastARow, "M"))
    Cells(1, "N") = "Value"
ColCtr = 15

Do While Cells(1, ColCtr) <> ""
    Range("RepeatData").Copy
    LastRow = Cells(Rows.Count, "L").End(xlUp).Row
    Cells(LastRow + 1, "A").Select
    ActiveSheet.Paste
    Columns(ColCtr).Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    TopRow = Cells(Rows.Count, "M").End(xlUp).Row
    LastRow = Cells(Rows.Count, "L").End(xlUp).Row
    Cells(1, "P").Copy Destination:=Range(Cells(2, "O"), Cells(LastARow, "O"))
    LastRow = Cells(Rows.Count, "O").End(xlUp).Row
    Range(Cells(2, "O"), Cells(LastRow, "P")).Copy
    TopRow = Cells(Rows.Count, "M").End(xlUp).Row
    Cells(TopRow + 1, "M").Select
    ActiveSheet.Paste
    Columns("O:P").Select
    Selection.Delete Shift:=xlToLeft
Loop
    Cells(1, 1).Select
End Sub