How to unpivot a Fixed number of columns with VBA just like Power Query

Question

I have 130 columns for example, and 13 of those columns have to be Unpivoted.

Number of rows vary from time to time.

This works with Power Query.

I attached a sample file to show how my data is being presented,

Columns A to E are the fixed array, and F onwards will be the columns subject for unpivoting.

I found out that PowerQuery also does VBA. I get an error here:

Sub Macro10()

    ActiveWorkbook.Queries.Add Name:="ProjectDetails (4)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Source = Excel.CurrentWorkbook(){[Name=""ProjectDetails""]}[Content]," & Chr(13) & "" & Chr(10) & "    #""Changed Type"" = Table.TransformColumnTypes(Source,{{""Project"", Int64.Type}, {""Project2"", Int64.Type}, {""Project Name"", type text}, {""Strategic Business Unit"", type text}, {""Area"", type text}, {""Sub Area"", type text}, {""Business Line"", type text}, {""Department"", ty" & _
        "pe text}, {""AECOM Project Review Category"", type text}, {""Customer Name"", type text}, {""Customer Type"", type text}, {""Project Manager"", type text}, {""Project Accountant"", type text}, {""Project Biller"", type text}, {""Regional Director"", type text}, {""Project Director"", type text}, {""Project Status"", type text}, {""End-Client Sector"", type text}, {" & _
        """Global Business Line"", type text}, {""AECOM Work"", type text}, {""AECOM Funding Source"", type text}, {""Distribution Rule"", type text}, {""Agreement"", type text}, {""CRM Tracking #"", type text}, {""Last Invoiced Date"", type any}, {""Last EAC Date"", type any}, {""Scheduled Start Date"", type datetime}, {""Scheduled Finish Date"", type datetime}, {""Forecast" & _
        " End Date"", type datetime}, {""AECOM Contract Type"", type text}, {""MTD Revenue"", type number}, {""MTD Total Costs"", type number}, {""MTD DL"", type number}, {""MTD Fringe"", type number}, {""MTD Overhead"", type number}, {""MTD ODC"", type number}, {""MTD Subs"", type number}, {""NSR MTD"", type number}, {""MTD GM"", type number}, {""MTD GM % of Revenues"", typ" & _
        "e number}, {""MTD NM"", type number}, {""Direct Labor Multiplier MTD"", type number}, {""Salary Cost Multiplier MTD"", type number}, {""MTD Bookings"", type number}, {""YTD Revenue"", type number}, {""YTD Total Costs"", type number}, {""YTD DL"", type number}, {""YTD Fringe"", type number}, {""YTD Overhead"", type number}, {""YTD ODC"", type number}, {""YTD Subs"", " & _
        "type number}, {""YTD NSR"", type number}, {""YTD GM"", type number}, {""YTD GM % of Revenue"", type number}, {""YTD NM"", type number}, {""YTD DLM"", type number}, {""YTD SCM"", type number}, {""YTD Bookings"", type number}, {""ITD Revenue"", type number}, {""ITD Total Costs"", type number}, {""ITD DL"", type number}, {""ITD Fringe"", type number}, {""ITD Overhead""" & _
        ", type number}, {""ITD ODC"", type number}, {""ITD Subs"", type number}, {""ITD NSR"", type number}, {""ITD GM"", type number}, {""ITD GM% of Revenue"", type number}, {""ITD NM"", type number}, {""ITD DLM"", type number}, {""ITD SCM"", type number}, {""Funded Value"", type number}, {""Backlog"", type number}, {""Unbilled >30"", type number}, {""Unbilled (BIEE)"", ty" & _
        "pe number}, {""ITD Billed"", type number}, {""Billing > 60"", type number}, {""Trade AR"", type number}, {""Retention"", Int64.Type}, {""Appr Revenue Budget"", type number}, {""Appr ODC Budget"", type number}, {""Appr Subs Budget"", type number}, {""Appr Contingency Budget"", type number}, {""Appr DL Budget"", type number}, {""Appr Fringe Budget"", type number}, {""" & _
        "Appr Cost Budget"", type number}, {""Appr DLM Budget"", type number}, {""Appr SCM Budget"", type number}, {""Frcst Revenue Budget"", type number}, {""Frcst ODC Budget"", type number}, {""Frcst Subs Budget"", type number}, {""Frcst Contingency Budget"", type number}, {""Frcst DL Budget"", type number}, {""Frcst Fringe Budget"", type number}, {""Frcst Overhead Budget" & _
        """, type number}, {""Frcst Cost Budget"", type number}, {""Frcst DLM"", type number}, {""Frcst SCM"", type number}, {""Source System Description"", type text}, {""Source System ID"", Int64.Type}, {""Valid for Review?"", type text}, {""Project Accountant Required"", type text}, {""Invoiced Over Contract "", type number}, {""Est. Collections over Contact "", type numb" & _
        "er}, {""Current ETC "", type number}, {""Trended Costs"", Int64.Type}, {""Est. ETC at Month End"", type number}, {""MTD NM% of NSR"", type any}, {""YTD NM% of NSR"", type any}, {""ITD NM% of NSR"", type any}, {""Percent Complete"", type any}, {""Backlog Burn Rate"", type any}, {""Billing Backlog"", type number}, {""Unbilled Reserve"", type number}, {""AR Reserve"", " & _
        "type number}, {""YTD Lost Margin"", type number}, {""Project Manager Location"", type text}, {""ROCV"", type text}, {""Low to Zero Backlog"", type text}, {""Negative Margin MTD"", type text}, {""Negative Margin YTD"", type text}, {""Negative Margin ITD"", type text}})," & Chr(13) & "" & Chr(10) & "    #""Unpivoted Columns"" = Table.UnpivotOtherColumns(#""Changed Type"", {""Project"", ""Project" & _
        "2"", ""Project Name"", ""Strategic Business Unit"", ""Area"", ""Sub Area"", ""Business Line"", ""Department"", ""AECOM Project Review Category"", ""Customer Name"", ""Customer Type"", ""Project Manager"", ""Project Accountant"", ""Project Biller"", ""Regional Director"", ""Project Director"", ""Project Status"", ""End-Client Sector"", ""Global Business Line"", ""AEC" & _
        "OM Work"", ""AECOM Funding Source"", ""Distribution Rule"", ""Agreement"", ""CRM Tracking #"", ""Last Invoiced Date"", ""Last EAC Date"", ""Scheduled Start Date"", ""Scheduled Finish Date"", ""Forecast End Date"", ""AECOM Contract Type"", ""MTD Revenue"", ""MTD Total Costs"", ""MTD DL"", ""MTD Fringe"", ""MTD Overhead"", ""MTD ODC"", ""MTD Subs"", ""NSR MTD"", ""MTD" & _
        " GM"", ""MTD GM % of Revenues"", ""MTD NM"", ""Direct Labor Multiplier MTD"", ""Salary Cost Multiplier MTD"", ""MTD Bookings"", ""YTD Revenue"", ""YTD Total Costs"", ""YTD DL"", ""YTD Fringe"", ""YTD Overhead"", ""YTD ODC"", ""YTD Subs"", ""YTD NSR"", ""YTD GM"", ""YTD GM % of Revenue"", ""YTD NM"", ""YTD DLM"", ""YTD SCM"", ""YTD Bookings"", ""ITD Revenue"", ""ITD " & _
        "Total Costs"", ""ITD DL"", ""ITD Fringe"", ""ITD Overhead"", ""ITD ODC"", ""ITD Subs"", ""ITD NSR"", ""ITD GM"", ""ITD GM% of Revenue"", ""ITD NM"", ""ITD DLM"", ""ITD SCM"", ""Funded Value"", ""Backlog"", ""Unbilled >30"", ""Unbilled (BIEE)"", ""ITD Billed"", ""Billing > 60"", ""Trade AR"", ""Retention"", ""Appr Revenue Budget"", ""Appr ODC Budget"", ""Appr Subs Bu" & _
        "dget"", ""Appr Contingency Budget"", ""Appr DL Budget"", ""Appr Fringe Budget"", ""Appr Cost Budget"", ""Appr DLM Budget"", ""Appr SCM Budget"", ""Frcst Revenue Budget"", ""Frcst ODC Budget"", ""Frcst Subs Budget"", ""Frcst Contingency Budget"", ""Frcst DL Budget"", ""Frcst Fringe Budget"", ""Frcst Overhead Budget"", ""Frcst Cost Budget"", ""Frcst DLM"", ""Frcst SCM" & _
        """, ""Source System Description"", ""Source System ID"", ""Valid for Review?"", ""Project Accountant Required"", ""Invoiced Over Contract "", ""Est. Collections over Contact "", ""Current ETC "", ""Trended Costs"", ""Est. ETC at Month End"", ""MTD NM% of NSR"", ""YTD NM% of NSR"", ""ITD NM% of NSR"", ""Percent Complete"", ""Backlog Burn Rate"", ""Billing Backlog"", " & _
        """Unbilled Reserve"", ""AR Reserve"", ""YTD Lost Margin"", ""Project Manager Location""}, ""Attribute"", ""Value"")" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Unpivoted Columns"""
    ActiveWorkbook.Worksheets.Add
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""ProjectDetails (4)"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [ProjectDetails (4)]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "ProjectDetails__4"
        .Refresh BackgroundQuery:=False
    End With
    Application.CommandBars("Queries and Connections").Visible = False
End Sub

ow really? i tried to do recording but it did not push through. i will then copy my Macro recording here. i am also trying to search for a macro that uses pq, but not one bit. :( — BoyDespasito, Oct 30 '20 at 20:47
[Here's one macro for example](https://stackoverflow.com/a/54534597/9245853). — BigBen, Oct 30 '20 at 20:51
VBA example: https://stackoverflow.com/questions/36365839/transpose-multiple-columns-to-multiple-rows-with-vba/36366394#36366394 — Tim Williams, Oct 30 '20 at 21:07
Thank you sir @TimWilliams. i've already checked into it and tried it with my data. only had two problems here and i am really sorry for being ignorant on this as i am very literally new in this field. forgive me. but here are my problems :
1) it does not unpivot the column header , which should be labeling each row values.
2) where can i modify here the number and location of fixed columns , and the location and number of columns to unpivot.
thank you once again for your greatness sir, but then again i wish you can forgive me for this ignorance. — BoyDespasito, Oct 30 '20 at 21:56
Thank you sir for the info @BigBen.
however i maybe too noobie still to understand them, like how can i relate this to my unpivoting columns via PQ . lol forgive me. i'll try to comprehend this as far as my prowess goes.
for now, my capability is to just record macro and copy and maybe do some modifications there that i can understand (e.g., cell placings) . but really thank you for the assist here. — BoyDespasito, Oct 30 '20 at 21:59
The second parameter `fixedCols` determines how many columns will remain unpivoted (**and they should be the left-most columns in your input data**). That would be 5 from your screenshot. Use `True` for `AddCategoryColumn` if you want to add a column in the output dataset for the pivoted column headers (month names in your example) from the input data. — Tim Williams, Oct 30 '20 at 22:13
Thanks again good Sir @TimWilliams. i basically understand what you mean however, i do not know how should i indicate in this code the number of left most fixed columns. is it here and instead of 2 i place 5 ' nC = UBound(data, 2)? as for the 'AddCategoryColumn' it is already showing 'true' here or might be looking at a wrong place, 'Optional AddCategoryColumn As Boolean = True' . but still did not add the column headers. — BoyDespasito, Oct 30 '20 at 22:36
oh my, i don't see my markdown formatting taking effect. i did exactly what was required. — BoyDespasito, Oct 30 '20 at 22:40
You should not need to adjust the code in the function - you just provide the relevant inputs as arguments. If you can share an example of your data I can show you exactly how it should look. — Tim Williams, Oct 30 '20 at 22:42
seems like StackOverflow doesnot allow file attachment, cant find it anywhere :( so here i try to describe it :
1) my data is in Columns A to DR, where the fixed Column is A:DN, and DO:DR will be our Unpivot Columns.
2) The output will be having Columns A to DN the Same and DO shows Attribute column to put the labels from Column Header and DP to show the Values — BoyDespasito, Oct 30 '20 at 23:01
any way sir, if this is too much to ask, i still am thankful for entertaining my questions thank you so much! — BoyDespasito, Oct 30 '20 at 23:16
You can share a file by uploading it to Google Drive/Box/OneDrive/etc and posting a link here. — Tim Williams, Oct 30 '20 at 23:21
Here you go awesome sir! [link]https://drive.google.com/file/d/1a-1s2IJ-12ozsV48imxa01XwJN0uv1KB/view?usp=sharing — BoyDespasito, Oct 30 '20 at 23:35

Tim Williams · Accepted Answer · 2020-11-02T19:45:56.690

With no changes to the UnPivotData function in the link I posted, this should do what you want, based on the file you posted:

Sub Tester()

    Dim p

    'get the unpivoted data as a 2-D array
    p = UnPivotData(ThisWorkbook.Sheets("data source").Range("A2").CurrentRegion, _
                  118, True, True)
    
    'I added a new sheet for the output
    With Sheets("output2")
        .Cells.ClearContents
        .Range("A1").Resize(UBound(p, 1), UBound(p, 2)).Value = p 'populate array to sheet
    End With

    'EDIT: alternative (slower) method to populate the sheet
    '      from the pivoted dataset.  Might need to use this
    '      if you have a large amount of data
'    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

Edit - adding the UnPivotData function:

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) = "Category"
        dOut(1, fixedCols + 2) = "Value"
    Else
        dOut(1, fixedCols + 1) = "Value"
    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

ow my god sir it worked!!! This is awesome. i am so thankful! not very familiar how this forum works so please let me know how can i repay you! — BoyDespasito, Nov 02 '20 at 09:20
All you need to do is accept the answer by clicking the check mark next to it. — Tim Williams, Nov 02 '20 at 15:51

How to unpivot a Fixed number of columns with VBA just like Power Query

1 Answers1

Linked