Stuck with Array Syntax - Convert Wide to Tall Format

[GeeWhiz7]

Hi Folks,
I am trying to take a wide format array and using vba convert it to a tall skinny format.
Currently my xl2bb is blocked so I pasted an example table at the bottom of this. Example wide format on left, desired format on right)

My starting code is here. I've tried a few different variations, sometimes closer to what I want sometimes farther, but not quite where I want to be.

Sub WideToSkinny()

Dim lastRow, lastCol, i, j, totRows As Long
Dim wsIn, wsOut As Worksheet
Dim inArray, outArray As Variant

Set wsIn = Worksheets("Sheet1")
Set wsOut = Worksheets("Sheet2")

lastRow = wsIn.Cells(Rows.Count, 1).End(xlUp).Row
lastCol = wsIn.Cells(1, Columns.Count).End(xlToLeft).Column

wsOut.Cells.Clear

inArray = wsIn.Range("A1").CurrentRegion.Value

totRows = (lastRow * (lastCol - 1)) - 1

ReDim outArray(1 To 1, 1 To totRows)

        For j = 1 To lastCol
            For i = 1 To lastRow
                '###This copies the date column, but I need it to repeat
                '###depending on number of data columns
                outArray(1, i) = inArray(i, 1)
                '###Missing code to get the additonal columns and put item/values in right place
                
            Next i
        Next j
        
MsgBox "Wait"

End Sub

Date	A	B				Item	Date	Value
11/1/2000​	0​	1327​				A	11/1/2000​	0​
12/1/2000​	0​	6427​				A	12/1/2000​	0​
1/1/2001​	0​	6726​				A	1/1/2001​	0​		Desired Result
2/1/2001​	6786​	6098​				A	2/1/2001​	6786​
3/1/2001​	8360​	5986​				A	3/1/2001​	8360​
4/1/2001​	9889​	4327​				A	4/1/2001​	9889​
5/1/2001​	9255​	5485​				A	5/1/2001​	9255​
6/1/2001​	8620​	5721​				A	6/1/2001​	8620​
7/1/2001​	7226​	6161​				A	7/1/2001​	7226​
						B	11/1/2000​	1327​
						B	12/1/2000​	6427​
						B	1/1/2001​	6726​
						B	2/1/2001​	6098​
						B	3/1/2001​	5986​
						B	4/1/2001​	4327​
						B	5/1/2001​	5485​
						B	6/1/2001​	5721​
						B	7/1/2001​	6161​

 

[alansidman]

unpivot your data with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Date"}, "Attribute", "Value"),
    #"Reordered Columns" = Table.ReorderColumns(#"Unpivoted Other Columns",{"Attribute", "Date", "Value"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Reordered Columns",{{"Date", type date}}),
    #"Sorted Rows" = Table.Sort(#"Changed Type",{{"Attribute", Order.Ascending}, {"Date", Order.Ascending}})
in
    #"Sorted Rows"

Book3
	A	B	C	D	E	F	G
2	Date	A	B		Attribute	Date	Value
3	11/1/2000	0	1327		A	1/1/2000	0
4	12/1/2000	0	6427		A	2/1/2000	6786
5	1/1/2000	0	6726		A	3/1/2000	8360
6	2/1/2000	6786	6098		A	4/1/2000	9889
7	3/1/2000	8360	5986		A	5/1/2000	9255
8	4/1/2000	9889	4327		A	6/1/2000	8620
9	5/1/2000	9255	5485		A	7/1/2000	7226
10	6/1/2000	8620	5721		A	11/1/2000	0
11	7/1/2000	7226	6161		A	12/1/2000	0
12					B	1/1/2000	6726
13					B	2/1/2000	6098
14					B	3/1/2000	5986
15					B	4/1/2000	4327
16					B	5/1/2000	5485
17					B	6/1/2000	5721
18					B	7/1/2000	6161
19					B	11/1/2000	1327
20					B	12/1/2000	6427
Sheet1

 

[GeeWhiz7]

unpivot your data with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Date"}, "Attribute", "Value"),
    #"Reordered Columns" = Table.ReorderColumns(#"Unpivoted Other Columns",{"Attribute", "Date", "Value"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Reordered Columns",{{"Date", type date}}),
    #"Sorted Rows" = Table.Sort(#"Changed Type",{{"Attribute", Order.Ascending}, {"Date", Order.Ascending}})
in
    #"Sorted Rows"

Book3
	A	B	C	D	E	F	G
2	Date	A	B		Attribute	Date	Value
3	11/1/2000	0	1327		A	1/1/2000	0
4	12/1/2000	0	6427		A	2/1/2000	6786
5	1/1/2000	0	6726		A	3/1/2000	8360
6	2/1/2000	6786	6098		A	4/1/2000	9889
7	3/1/2000	8360	5986		A	5/1/2000	9255
8	4/1/2000	9889	4327		A	6/1/2000	8620
9	5/1/2000	9255	5485		A	7/1/2000	7226
10	6/1/2000	8620	5721		A	11/1/2000	0
11	7/1/2000	7226	6161		A	12/1/2000	0
12					B	1/1/2000	6726
13					B	2/1/2000	6098
14					B	3/1/2000	5986
15					B	4/1/2000	4327
16					B	5/1/2000	5485
17					B	6/1/2000	5721
18					B	7/1/2000	6161
19					B	11/1/2000	1327
20					B	12/1/2000	6427
Sheet1

Thank you Alan, this looks like it will work, but I must say the Power Query editor is less than intuitive for me to figure out how to implement this especially when compared to Spotfire for example. But, that's likely more my zero skills with Power Query. Once I figure it out and put your code in, I'll come back to the forum.

 

[alansidman]

If you are looking for a really good Primer, then I suggest you purchase --> Master Your Data with Power Query in Excel and Power BI

 

[Flaiban]

Try this code , GeeWhiz...

Sub Transpose()

Dim I As Integer
Dim Column As Integer
Dim Row As Integer
Dim Row2 As Integer

I = ActiveSheet.Range("E:E").Find(Empty).Row
    ActiveSheet.Range("E2:G" & I).ClearContents
    
Column = 2
Row = 2
Row2 = 2


With ActiveSheet
    Do Until .Cells(1, Column).Value = ""
        Do Until .Cells(Row, 1).Value = ""
            If .Cells(Row, Column).Value <> "" Then
                .Cells(Row2, "F") = .Cells(Row, "A")
                .Cells(Row2, "E") = .Cells(1, Column)
                .Cells(Row2, "G") = .Cells(Row, Column)
                
                Row2 = Row2 + 1
            End If
        Row = Row + 1
        
        Loop
        Row = 2
        Column = Column + 1
    Loop
    
End With

End Sub

 

[GeeWhiz7]

Try this code , GeeWhiz...

Sub Transpose()

Dim I As Integer
Dim Column As Integer
Dim Row As Integer
Dim Row2 As Integer

I = ActiveSheet.Range("E:E").Find(Empty).Row
    ActiveSheet.Range("E2:G" & I).ClearContents
   
Column = 2
Row = 2
Row2 = 2


With ActiveSheet
    Do Until .Cells(1, Column).Value = ""
        Do Until .Cells(Row, 1).Value = ""
            If .Cells(Row, Column).Value <> "" Then
                .Cells(Row2, "F") = .Cells(Row, "A")
                .Cells(Row2, "E") = .Cells(1, Column)
                .Cells(Row2, "G") = .Cells(Row, Column)
               
                Row2 = Row2 + 1
            End If
        Row = Row + 1
       
        Loop
        Row = 2
        Column = Column + 1
    Loop
   
End With

End Sub

Thank you Flaiban! This works great as a pure vba way and helps me understand what I was doing wrong. Probably I have uses for both Alan's way now that I see it's pretty easy to unpivot other columns in the Power Query Editor, but this will be easier for uses where other users will need to transform the data and a button click to a macro will serve that better.

 

[Flaiban]

Glad we could help , and thanks for the feedback.