Restructure Excel table with VBA - excel

Question

I have an Excel table source (extract is below):
Models are changing (adding new names, removing), so does change Week number in Columns (from Now till end of the year)
I need to restructure it so that it could look like this:
So that it could be normally used for further querying.
In each row there must be model name, for each model there should be Week number and corresponding matching Quantity taken from the table itself (on the intersection of Model X Week from original table).
I was smashing my head against the wall on how it can be realized in VBA. Couldn't restructure it with simple code.

Answer 1

try this code, just change the name of your sheets I used 2, the first is the source and the second is the destination, I hope help you
good Luck
Sub RestructureTable()
Const SourceSheetName = "Source", DestinationSheetName = "Restructure" 'Your sheet names
Dim nRowCounter As Double, nColumnSourceCounter As Double, nRowSourceCounter As Double
'--------
'-------Set the headers in destination sheet
Sheets(DestinationSheetName).Range("A1") = "Models" 'Replace "Models" as you need
Sheets(DestinationSheetName).Range("B1") = "Week" 'Replace "Week" as you need
Sheets(DestinationSheetName).Range("C1") = "Qty" 'Replace "Qty" as you need
'--------
'----------------------------------------------------
Sheets(SourceSheetName).Select 'Select the source sheet
Range("A2").Select ' select the first cell with data
nRowCounter = 2 ' Start in 2 cuase headers
'---------------------------------------------------
nRowSourceCounter = ThisWorkbook.Application.WorksheetFunction.CountA(Range("A:A")) 'count rows
nColumnSourceCounter = ThisWorkbook.Application.WorksheetFunction.CountA(Range("1:1")) 'count columns
For r = 2 To nRowSourceCounter
For c = 2 To nColumnSourceCounter
'Model
Sheets(DestinationSheetName).Range("A" & nRowCounter) = Sheets(SourceSheetName).Cells(r, 1)
'Header:Week
Sheets(DestinationSheetName).Range("B" & nRowCounter) = Sheets(SourceSheetName).Cells(1, c)
'Qty
Sheets(DestinationSheetName).Range("C" & nRowCounter) = Sheets(SourceSheetName).Cells(r, c)
nRowCounter = nRowCounter + 1
Next c
Next r
End Sub

Answer 2

You could do this with VBA but you could also do it with only a few steps using Power Query.
VBA Method
Here's code to do it with VBA, it assumes the data to restructure is in a sheet named Data and starts at A1.
In this code the restructured data is put on a new sheet but you could change that to put it on an existing sheet.
Option Explicit
Sub RestructureData()
Dim ws As Worksheet
Dim arrDataIn As Variant
Dim arrDataOut() As Variant
Dim cnt As Long
Dim idxCol As Long
Dim idxRow As Long
arrDataIn = Sheets("Data").Range("A1").CurrentRegion.Value
ReDim arrDataOut(1 To (UBound(arrDataIn, 1) - 1) * (UBound(arrDataIn, 2) - 1), 1 To 3)
For idxRow = LBound(arrDataIn, 1) + 1 To UBound(arrDataIn, 1)
For idxCol = LBound(arrDataIn, 2) + 1 To UBound(arrDataIn, 2)
cnt = cnt + 1
arrDataOut(cnt, 1) = arrDataIn(idxRow, 1)
arrDataOut(cnt, 2) = arrDataIn(1, idxCol)
arrDataOut(cnt, 3) = arrDataIn(idxRow, idxCol)
Next idxCol
Next idxRow
Set ws = Sheets.Add ' can be set to existing worksheet
ws.Range("A1:C1").Value = Array("Model", "Week", "Quantity")
ws.Range("A2").Resize(cnt, 3).Value = arrDataOut
End Sub
Power Query Method
Go to the sheet with the data, then go to the Data>Get & Transform Data tab.
Select From Table/Range, make sure all the data is selected and Does your data have headers? is ticked.
In Power Query select the Model column, right click and select Unpivot Other Columns.
Rename the Attribute column 'Week' and the value column 'Quantity' by double click each column header.
Click Close & Load to return the data to Excel.
This is the M Code those steps produce.
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
#"Changed Type" = Table.TransformColumnTypes(Source,{{"Models", type text}, {"2021-03-29_(W13)", Int64.Type}, {"2021-04-05_(W14)", Int64.Type}, {"2021-04-12_(W15)", Int64.Type}, {"2021-04-19_(W16)", Int64.Type}, {"2021-04-26_(W17)", Int64.Type}}),
#"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Models"}, "Attribute", "Value"),
#"Renamed Columns" = Table.RenameColumns(#"Unpivoted Other Columns",{{"Attribute", "Week"}, {"Value", "Quantity"}})
in
#"Renamed Columns"