VBA transposing an array with parameters

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.

This transformation is called unpivoting and the easiest way to do it is by using Power Query. I think you select the first column with the values and find Unpivot Column and continue playing with it. It is part of Excel since version 2016 when it was called Get & Transform. In my 2019 version, in the Data tab, you select From Table/Range. — VBasic2008
– VBasic2008, Commented Feb 18, 2022 at 19:43
Can you edit your question and supply your existing situation as editable? I would like to try something, but I do not want to manually reproduce it... — FaneDuru
– FaneDuru, Commented Feb 18, 2022 at 19:53

FaneDuru · Accepted Answer · 2022-02-18 20:48:50Z

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

Comments are not for extended discussion; this conversation has been moved to chat.

Ron Rosenfeld · Accepted Answer · 2022-02-20 06:42:46Z

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

edited Feb 20, 2022 at 6:42

answered Feb 20, 2022 at 2:23

Ron Rosenfeld

62k7 gold badges35 silver badges71 bronze badges

9 Comments

Efernity92 Over a year ago

many thanks, I'll try and will let you know.

Efernity92 Over a year ago

is there any way how the year can be adjusted dynamically? We're planning 6 months ahead so in July I'll have to set January to 2023. Do you think it's manageable?

Ron Rosenfeld Over a year ago

@Eternity92 Depends on the actual rule. For example, one could easily extract the year from a date that is 6 months from today. Or you could extract it from your date column if that is a reliable method.

Efernity92 Over a year ago

I see, in order to do it I'll need to use Date.Month(DateTime.LocalNow() + 6 , however I'm not sure how to achieve automatic change to 2023. Thank you in advance.

Ron Rosenfeld Over a year ago

@Efernity92 If that will be your algorithm, you can compute the year with somthing like: year = DateTime.ToText(Date.AddMonths(DateTime.LocalNow(),6),"yyyy") and then use that in place the hard-coded year in the mnthCol = step.

|

Collectives™ on Stack Overflow

VBA transposing an array with parameters

2 Answers 2

1 Comment

9 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

1 Comment

9 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related