VBA transposing an array with parameters - excel

Question

I've managed to record all changes my team has done and in order to use it further I'll need to transpose the table into format supported by our systems. I was able to transpose one row but there are hundreds in my file so my code was useless.
My input table look like this
My goal for output looks like this
I've managed to transpose the whole table from tutorial (Essential Excel), however it doesn't fit my needs.
Sub TransposeTest()
Dim wks As Worksheet, wks2 As Worksheet
Dim MyArray As Variant
Dim LastRow As Integer, LastColumn As Integer
Dim StartCells As Range
Set wks = ThisWorkbook.Sheets("Sheet1")
Set wks2 = ThisWorkbook.Sheets("Transpose")
Set StartCell = wks.Range("A2")
LastRow = wks.Cells(wks.Rows.Count, StartCell.Column).End(xlUp).row
LastColumn = wks.Cells(StartCell.row, wks.Columns.Count).End(xlToLeft).Column
MyArray = wks.Range(StartCell, wks.Cells(LastRow, LastColumn)).Value2
MyArray = WorksheetFunction.Transpose(MyArray)
wks2.Range("a2", wks2.Cells(LastColumn, LastRow)).Value = MyArray
End Sub
I've been advised to use array for months and loop through each row however I unable to achieve it.

Answer 1

Please, try the next code. It should be very fast, even for large ranges. It uses arrays and works only in memory, the result being dropped at once:
Sub TransposeData()
Dim sh As Worksheet, shTr As Worksheet, lastR As Long, arr, arrfin, ArrH, i As Long, k As Long, j As Long
Set sh = ActiveSheet
Set shTr = sh.Next 'use here the sheet you need to return.
'if the next sheet is empty you can let the code as it is
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
arr = sh.Range("A1:Q" & lastR).value 'place the range in an array for faster iteration
ReDim arrfin(1 To UBound(arr) * 12 + 1, 1 To 7): k = 1 'redim the final array dimensions
ArrH = Split("Index,Person,Dept,Month,Sales,STMP,User", ",") 'create an array from the header strings
'place the headers in the first row of the final array:
For i = 0 To UBound(ArrH): arrfin(k, i + 1) = ArrH(i): Next: k = k + 1
'build the final array:
For i = 2 To UBound(arr)
For j = 1 To 12
arrfin(k + j - 1, 1) = arr(i, 1): arrfin(k + j - 1, 2) = arr(i, 2): arrfin(k + j - 1, 3) = arr(i, 3)
arrfin(k + j - 1, 4) = j & "." & Year(Date): arrfin(k + j - 1, 5) = arr(i, j + 3)
arrfin(k + j - 1, 6) = arr(i, 16): arrfin(k + j - 1, 7) = arr(i, 17)
Next j
k = k + j - 1 'reinitialize k variable for the next data row
Next i
'drop the final array content at once, and do some formatting:
With shTr.Range("A1").Resize(UBound(arrfin), UBound(arrfin, 2))
.value = arrfin
.rows(1).Font.Bold = True
.EntireColumn.AutoFit
For i = 7 To 9
.Borders(i).Weight = xlThin
.Borders.LineStyle = xlContinuous
Next
End With
MsgBox "Ready..."
End Sub

Answer 2

You can obtain your desired output using Power Query, available in Windows Excel 2010+ and Office 365 Excel
Select some cell in your original table
Data => Get&Transform => From Table/Range or From within sheet
When the PQ UI opens, navigate to Home => Advanced Editor
Make note of the Table Name in Line 2 of the code.
Replace the existing code with the M-Code below
Change the table name in line 2 of the pasted code to your "real" table name
Examine any comments, and also the Applied Steps window, to better understand the algorithm and steps
M Code
let
//Change table name in next row to the actual table name in your workbook
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
//set the data types
#"Changed Type" = Table.TransformColumnTypes(Source,{
{"Index", Int64.Type}, {"Person", Int64.Type}, {"Dept", Int64.Type},
{"Jan", Int64.Type}, {"Feb", Int64.Type}, {"Mar", Int64.Type},
{"Apr", Int64.Type}, {"May", Int64.Type}, {"Jun", Int64.Type},
{"Jul", Int64.Type}, {"Aug", Int64.Type}, {"Sep", Int64.Type},
{"Oct", Int64.Type}, {"Nov", Int64.Type}, {"Dec", Int64.Type},
{"Time", type datetime}, {"User", type text}},"en-150"),
//Unpivot the Month columns
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type",
{"Index", "Person", "Dept", "Time", "User"}, "Month", "Sales"),
//Transform "Month" column to "MonthNum.YearNum
//Not sure where the year should come from.
// for now will just hard code at as 2022
// but could use a different method.
mnthCol = Table.TransformColumns(#"Unpivoted Other Columns", {"Month", each
Date.ToText(Date.FromText("1-" & _ & "-2022"),"M.yyyy"),type text}),
//Reorder the columns
#"Reordered Columns" = Table.ReorderColumns(mnthCol,{"Index", "Person", "Dept", "Month", "Sales", "Time", "User"}),
//Rename the columns as per your example
rename = Table.RenameColumns(#"Reordered Columns",{
{"Time","STMP"},
{"Dept","Depr"}
})
in
rename
Original Data
Partial Results