Multidimensional Matrix Transpose in Excel (Macro) - excel

Question

I have some "multidimensional" data in an Excel spreadsheet that currently look like this below:
I'd like to transform this into rows with multiple columns:
I have tried multiple macros but still can't handle all dimensions to transpose correctly to rows, would be extremely grateful for any help :)
P.
Here's the code which works well without 3rd dimension (sales type):
Sub test()
Dim inputRange As Range, inputRRay As Variant
Dim outputRange As Range, outputRRay() As Variant
Dim outRow As Long, inCol As Long, inRow As Long
Set inputRange = ThisWorkbook.Sheets("Sheet1").Range("A1:AA150")
Set outputRange = ThisWorkbook.Sheets("Sheet2").Range("A1")
inputRRay = inputRange.Value
ReDim outputRRay(1 To (UBound(inputRRay, 1) * UBound(inputRRay, 2)), 1 To 3)
outRow = 0
For inCol = 2 To UBound(inputRRay, 2)
For inRow = 2 To UBound(inputRRay, 1)
If inputRRay(inRow, inCol) <> vbNullString And inputRRay(inRow, inCol) <> 0 Then
outRow = outRow + 1
outputRRay(outRow, 1) = inputRRay(1, inCol)
outputRRay(outRow, 2) = inputRRay(inRow, 1)
outputRRay(outRow, 3) = inputRRay(inRow, inCol)
End If
Next inRow
Next inCol
With outputRange.Resize(1, 3)
.EntireColumn.Clear
.Value = Array("Store", "Product", "QTY")
.Font.FontStyle = "Bold"
End With
With outputRange.Offset(1, 0).Resize(UBound(outputRRay, 1), UBound(outputRRay, 2))
.Value = outputRRay
End With
With outputRange.Parent
With Range(outputRange.Range("a1"), .Cells(.Rows.Count, outputRange.Column).End(xlUp)).Resize(, 3)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Columns.AutoFit
End With
End With
End Sub

Answer 1

If you're specifically after a VBA solution, then I think you might be over-complicating your code.
Your range definition looks odd. I don't quite see why you're selecting columns "A" to "AA" when the data is only in the first 7 columns. And the data transfer should simply be a case of looping the rows and then each column to transfer into the output array. The desired code would look something like the below. I've left all the formatting bits out as you can tailor that to however you want it.
It does seem as if this code has been lifted from somewhere else and you've tried to adjust it. That's fine, but it does require you to understand what the original code is doing, and it's nor obvious to me that you have that understanding. You might get more success if you write your code from scratch so that you know where the loops are taking you.
Dim data As Variant
Dim fmt As String
Dim output() As Variant
Dim r As Long, x As Long, i As Long
'Define your range
With Sheet1
data = .Range(.Range("A1"), _
.Range("A" & .Rows.Count).End(xlUp)) _
.Resize(, 7) _
.Value2
End With
'Redim output array based on range size.
'Note the + 1 for a header.
ReDim output(1 To UBound(data, 1) * 6 + 1, 1 To 4)
'Write the header.
output(1, 1) = "Product"
output(1, 2) = "Store"
output(1, 3) = "Sales Type"
output(1, 4) = "Qty"
'Transfer the data to output array.
i = 2 'index of ouput array
For r = 3 To UBound(data, 1)
For x = 0 To 5 'loops the 5 columns in each row
output(i + x, 1) = data(r, 1) 'product
output(i + x, 2) = data(1, IIf(x < 3, 2, 5)) 'store
output(i + x, 3) = data(2, x + 2) 'type
output(i + x, 4) = data(r, x + 2) 'qty
Next
i = i + 6 'increment output index by 6 rows
Next
'Write output to sheet.
Sheet2.Range("A1") _
.Resize(UBound(output, 1), _
UBound(output, 2)) _
.Value = output