Excel - transposing multiple columns into rows

Question

I am trying to transpose multiple date columns into rows as shown in the picture below. I have around 200 products with 20 campaigns each and running on 3 different devices.

Answer 1

1) Powerquery

You can do this easily with Powerquery add-in for pre Excel 2016 and for 2016 it is in built within data tab (Get & Transform). More info here.

See Gif below. For pre-2016 use Powerquery tab rather than data tab to access query from table.

M code:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Product", type text}, {"Campaign", type text}, {"Device", type text}, {"01-Jan-18", Int64.Type}, {"02-Jan-18", Int64.Type}, {"03-Jan-18", Int64.Type}, {"04-Jan-18", Int64.Type}, {"05-Jan-18", Int64.Type}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Product", "Campaign", "Device"}, "Attribute", "Value"),
    #"Renamed Columns" = Table.RenameColumns(#"Unpivoted Columns",{{"Attribute", "Date"}, {"Value", "Spend"}}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Renamed Columns",{{"Spend", Currency.Type}})
in
    #"Changed Type1"

2) With vba code adapted from Ioancosmin

Option Explicit

Sub Tester()

    Dim p

    'get the unpivoted data as a 2-D array
    p = UnPivotData(Sheets("Sheet1").Range("A1").CurrentRegion, _
                    3, True, False)

    Dim r As Long, c As Long
    For r = 1 To UBound(p, 1)

        For c = 1 To UBound(p, 2)
            Sheets("Sheet2").Cells(r, c).Value = p(r, c)
        Next c

    Next r

End Sub

Function UnPivotData(rngSrc As Range, fixedCols As Long, _
                     Optional AddCategoryColumn As Boolean = True, _
                     Optional IncludeBlanks As Boolean = True)

    Dim nR As Long, nC As Long, data, dOut()
    Dim r As Long, c As Long, rOut As Long, cOut As Long, cat As Long
    Dim outRows As Long, outCols As Long

    data = rngSrc.Value                          'get the whole table as a 2-D array
    nR = UBound(data, 1)                         'how many rows
    nC = UBound(data, 2)                         'how many cols

    'calculate the size of the final unpivoted table
    outRows = nR * (nC - fixedCols)
    outCols = fixedCols + IIf(AddCategoryColumn, 2, 1)

    'resize the output array
    ReDim dOut(1 To outRows, 1 To outCols)

    'populate the header row
    For c = 1 To fixedCols
        dOut(1, c) = data(1, c)
    Next c
    If AddCategoryColumn Then
        dOut(1, fixedCols + 1) = "Date"
        dOut(1, fixedCols + 2) = "Amount"
    Else
        dOut(1, fixedCols + 1) = "Amount"
    End If


    'populate the data
    rOut = 1
    For r = 2 To nR
        For cat = fixedCols + 1 To nC


            If IncludeBlanks Or Len(data(r, cat)) > 0 Then
                rOut = rOut + 1
                'Fixed columns...
                For c = 1 To fixedCols
                    dOut(rOut, c) = data(r, c)
                Next c
                'populate unpivoted values
                If AddCategoryColumn Then
                    dOut(rOut, fixedCols + 1) = data(1, cat)
                    dOut(rOut, fixedCols + 2) = data(r, cat)
                Else
                    dOut(rOut, fixedCols + 1) = data(r, cat)
                End If
            End If

        Next cat
    Next r

    UnPivotData = dOut
End Function