Macro Help - Transpose Quantity and QTR (Large amount of data)

[tommiexboi]

Hello,

Basically, I have over 1200 part numbers and I'm looking at an 8 quarter forecast.
I am trying to get the below result that will be quick and efficient. Would like to be able to sort by quarter and etc.

Any help will be greatly appreciated.


Current:

Part Number	QTR 1	QTR 2	QTR 3	QTR 4	QTR 1	QTR 2	QTR 3	QTR 4
ABC123	67	8	8	3	1	3	0	4
ABC124	1	2	10	4	2	6	0	6
ABC125	3	5	12	5	3	9	3	3

<tbody>
</tbody>

Result Needed:

Part Number	Quarter	Quantity
ABC123	QTR 1	67
ABC123	QTR 2	8
ABC123	QTR 3	8
ABC123	QTR 4	3
ABC123	QTR 1	1
ABC123	QTR 2	3
ABC123	QTR 3	0
ABC123	QTR 4	4
ABC124	QTR 1	1
ABC124	QTR 2	2
ABC124	QTR 3	10
ABC124	QTR 4	4
ABC124	QTR 1	2
ABC124	QTR 2	6
ABC124	QTR 3	0
ABC124	QTR 4	6
ABC124	QTR 1	3
ABC124	QTR 2	5
ABC124	QTR 3	12
ABC124	QTR 4	5
ABC124	QTR 1	3
ABC124	QTR 2	9
ABC124	QTR 3	3
ABC124	QTR 4	3

<tbody>
</tbody>

 

[Peter_SSs]

Try this with a copy of your data.

Sub TransposeQuarters()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  With Range("A1").CurrentRegion
    a = .Value
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
    For i = 2 To UBound(a, 1)
      For j = 2 To UBound(a, 2)
        k = k + 1
        b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j)
      Next j
    Next i
    With .Offset(1, .Columns.Count + 2).Resize(UBound(b), 3)
      .Value = b
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity")
      .EntireColumn.AutoFit
    End With
  End With
End Sub

Here is my data (cols A:I) and results of that code (cols L:N)

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Part Number	QTR 1	QTR 2	QTR 3	QTR 4	QTR 1	QTR 2	QTR 3	QTR 4			Part Number	Quarter	Quantity
2	ABC123	67	8	8	3	1	3	0	4			ABC123	QTR 1	67
3	ABC124	1	2	10	4	2	6	0	6			ABC123	QTR 2	8
4	ABC125	3	5	12	5	3	9	3	3			ABC123	QTR 3	8
5												ABC123	QTR 4	3
6												ABC123	QTR 1	1
7												ABC123	QTR 2	3
8												ABC123	QTR 3	0
9												ABC123	QTR 4	4
10												ABC124	QTR 1	1
11												ABC124	QTR 2	2
12												ABC124	QTR 3	10
13												ABC124	QTR 4	4
14												ABC124	QTR 1	2
15												ABC124	QTR 2	6
16												ABC124	QTR 3	0
17												ABC124	QTR 4	6
18												ABC125	QTR 1	3
19												ABC125	QTR 2	5
20												ABC125	QTR 3	12
21												ABC125	QTR 4	5
22												ABC125	QTR 1	3
23												ABC125	QTR 2	9
24												ABC125	QTR 3	3
25												ABC125	QTR 4	3
Transpose

 

[tommiexboi]

Awesome! This works!

Now a little bit more:
- How about if the result needs to be on a different sheet (lets say Sheet2) and start from A2.

Also could you explain how this macro works (possibly a step by step) so that I can play around with it?

Thanks

 

[Peter_SSs]

See if this is sufficient.

Sub TransposeQuarters()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  'Use 'CurrentRegion' to collect all data as it seems like a solid block of data
  With Sheets("Sheet1").Range("A1").CurrentRegion '<- Check sheet name
    'Read all the values into an array in memory. Imaginec this array to look like the data on the sheet
    a = .Value
    'Make array b big enough to hold results - basically rows of data numbers x columns of data numbers
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
    'For each row of numbers
    For i = 2 To UBound(a, 1)
      'Work across all the columns in that row of numbers
      For j = 2 To UBound(a, 2)
        'Go to a new row in the results array (b)
        k = k + 1
        '1st value in the results array for that row is the 'row header' from that row of the data
        '2nd value is the 'column header' for that value
        '3rd value is the numerical value itsef
        b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j)
      Next j
    Next i
    'In the results sheet, prepare a range the same size as the results array
    With Sheets("Sheet2").Range("A2").Resize(UBound(b), 3)  '<- Check sheet name
      'Write the array values to the worksheet
      .Value = b
      'Put the headings in the row above
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity")
      'Resize the columns to fit the data
      .EntireColumn.AutoFit
    End With
  End With
End Sub

 

[tommiexboi]

See if this is sufficient.

Sub TransposeQuarters()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
 
  'Use 'CurrentRegion' to collect all data as it seems like a solid block of data
  With Sheets("Sheet1").Range("A1").CurrentRegion '<- Check sheet name
    'Read all the values into an array in memory. Imaginec this array to look like the data on the sheet
    a = .Value
    'Make array b big enough to hold results - basically rows of data numbers x columns of data numbers
    ReDim b(1 To (UBound(a, 1) - 1) * (UBound(a, 2) - 1), 1 To 3)
    'For each row of numbers
    For i = 2 To UBound(a, 1)
      'Work across all the columns in that row of numbers
      For j = 2 To UBound(a, 2)
        'Go to a new row in the results array (b)
        k = k + 1
        '1st value in the results array for that row is the 'row header' from that row of the data
        '2nd value is the 'column header' for that value
        '3rd value is the numerical value itsef
        b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j)
      Next j
    Next i
    'In the results sheet, prepare a range the same size as the results array
    With Sheets("Sheet2").Range("A2").Resize(UBound(b), 3)  '<- Check sheet name
      'Write the array values to the worksheet
      .Value = b
      'Put the headings in the row above
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity")
      'Resize the columns to fit the data
      .EntireColumn.AutoFit
    End With
  End With
End Sub

Hi Peter or anyone that can help!

The macro helped me out greatly and I really appreciate it! But now I ran into another issue, I have another measure that needs to be transposed.
Also the QTR's can vary.. Sometimes it's QTR 1~QTR 4 or QTR 1~QTR 8 depending on which report I'm running.

Current:

	Quantity	Quantity	Quantity	Quantity	Price	Price	Price	Price
Part Number	QTR 1	QTR 2	QTR 3	QTR 4	QTR 1	QTR 2	QTR 3	QTR 4
ABC123	100	150	200	250	$3	$3	$1	$3
ABC124	200	200	200	200	$2	$1	$1	$5
ABC125	150	150	100	100	$3	$3	$3	$3

Needed Results

Part Number	Quarter	Quantity	Price
ABC123	QTR 1	100	$3
ABC123	QTR 2	150	$3
ABC123	QTR 3	200	$1
ABC123	QTR 4	250	$3
ABC124	QTR 1	200	$2
ABC124	QTR 2	200	$1
ABC124	QTR 3	200	$1
ABC124	QTR 4	200	$5
ABC125	QTR 1	150	$3
ABC125	QTR 2	150	$3
ABC125	QTR 3	100	$3
ABC125	QTR 4	100	$3

Thank you in advance

 

[Peter_SSs]

I have another measure that needs to be transposed.

Try this

Sub TransposeQuarters_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, numQtrs As Long
  
  'Use 'CurrentRegion' to collect all data as it seems like a solid block of data
  With Sheets("Sheet1").Range("A1").CurrentRegion '<- Check sheet name
    'Read all the values into an array in memory. Imagine this array to look like the data on the sheet
    a = .Value
    'Calculate how many quarters
    numQtrs = (UBound(a, 2) - 1) / 2
    'Make array b big enough to hold results - basically rows of data numbers x no. of 'Price' columns
    ReDim b(1 To (UBound(a, 1) - 2) * numQtrs, 1 To 4)
    'For each row of numbers
    For i = 3 To UBound(a, 1)
      'Work across all the Quarter columns in that row
      For j = 2 To 1 + numQtrs
        'Go to a new row in the results array (b)
        k = k + 1
        '1st value in the results array for that row is the 'row header' from that row of the data
        '2nd value is the 'Qtr header' for that value
        '3rd value is the Qtr Quantity
        '4th value is the Qtr Price
        b(k, 1) = a(i, 1): b(k, 2) = a(2, j): b(k, 3) = a(i, j): b(k, 4) = a(i, j + numQtrs)
      Next j
    Next i
    'In the results sheet, prepare a range the same size as the results array
    With Sheets("Sheet2").Range("A2").Resize(UBound(b), 4)  '<- Check sheet name
      'Write the array values to the worksheet
      .Value = b
      'Put the headings in the row above
      .Rows(0).Value = Array("Part Number", "Quarter", "Quantity", "Price")
      'Resize the columns to fit the data
      .EntireColumn.AutoFit
    End With
  End With
End Sub

 

[alansidman]

Load your table to Power Query/Get and Transform. Unpivot the table. Load to Excel. Mcode follows.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(Source, {"Part Number"}, "Attribute", "Value")
in
    #"Unpivoted Other Columns"

Book1
	A	B	C
1	Part Number	Attribute	Value
2	ABC123	QTR 1	67
3	ABC123	QTR 2	8
4	ABC123	QTR 3	8
5	ABC123	QTR 4	3
6	ABC123	QTR 12	1
7	ABC123	QTR 23	3
8	ABC123	QTR 34	0
9	ABC123	QTR 45	4
10	ABC124	QTR 1	1
11	ABC124	QTR 2	2
12	ABC124	QTR 3	10
13	ABC124	QTR 4	4
14	ABC124	QTR 12	2
15	ABC124	QTR 23	6
16	ABC124	QTR 34	0
17	ABC124	QTR 45	6
18	ABC125	QTR 1	3
19	ABC125	QTR 2	5
20	ABC125	QTR 3	12
21	ABC125	QTR 4	5
22	ABC125	QTR 12	3
23	ABC125	QTR 23	9
24	ABC125	QTR 34	3
25	ABC125	QTR 45	3
Sheet4

 

[sandy666]

with Power Query

Part Number	Qtr	Qty	Price
ABC123	QTR 1	100	3
ABC123	QTR 2	150	3
ABC123	QTR 3	200	1
ABC123	QTR 4	250	3
ABC124	QTR 1	200	2
ABC124	QTR 2	200	1
ABC124	QTR 3	200	1
ABC124	QTR 4	200	5
ABC125	QTR 1	150	3
ABC125	QTR 2	150	3
ABC125	QTR 3	100	3
ABC125	QTR 4	100	3

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

    TSC = Table.SelectColumns(Source,{"Column1", "Column2", "Column3", "Column4", "Column5"}),
    UOC = Table.UnpivotOtherColumns(Table.PromoteHeaders(Table.PromoteHeaders(TSC, [PromoteAllScalars=true]), [PromoteAllScalars=true]), {"Part Number"}, "Qtr", "Qty"),

    TSC1 = Table.SelectColumns(Source,{"Column1", "Column6", "Column7", "Column8", "Column9"}),
    UOC1 = Table.UnpivotOtherColumns(Table.PromoteHeaders(Table.PromoteHeaders(TSC1, [PromoteAllScalars=true]), [PromoteAllScalars=true]), {"Part Number"}, "Qtr", "Price"),

    Price = Table.AddColumn(UOC1, "Pricex", each "Price"),
    Pivot = Table.Pivot(Price, List.Distinct(Price[Pricex]), "Pricex", "Price"),

    Mrg = Table.NestedJoin(UOC,{"Part Number", "Qtr"},Pivot,{"Part Number", "Qtr"},"Table",JoinKind.LeftOuter),
    Result = Table.TransformColumnTypes(Table.ReplaceValue(Table.ExpandTableColumn(Mrg, "Table", {"Price"}, {"Price"}),"$","",Replacer.ReplaceText,{"Price"}),{{"Qty", type number}, {"Price", type number}})

in
    Result

 

[tommiexboi]

Thank you all!
I still need to learn power query. Seems like it's something much useful in this day and age.

I really appreciate your help!!

 

[sandy666]

You are welcome