Stack the data into columns into rows

[klllmmm]

I have a large dataset with product related data in different columns for each data.

Date	Product A	Product A	Product B	Product B
	Qty	Value	Qty	Value
01-09-2017	50	1000	40	800
02-09-2017	60	1200	20	400

<tbody>
</tbody>

I want to make it columner base dataset similar below table.

Date	Product	Qty	Value
01-09-2017	Product A	50	1000
01-09-2017	Product B	40	800
02-09-2017	Product A	60	1200
02-09-2017	Product B	20	400

<tbody>
</tbody>

Is there a way to do this.
Thanks for your time & efforts.
Regards,
Klllmmm

 

[Oeldere]

You can run this code on a copy of your data

Sub CONVERTROWSTOCOL_Oeldere_revisted_new()

Dim rsht1 As Long, rsht2 As Long, i As Long, col As Long, wsTest As Worksheet, mr As Worksheet, ms As Worksheet

'check if sheet "output" already exist

Const strSheetName As String = "Output"

Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

'set the data
                 

Set mr = Sheets("sheet1")                                  'this is the name of the source sheet
 
Set ms = Sheets("Output")                                       'this is the name of the destiny sheet

col = 2
col2 = 3
'End set the data

    With ms
     .UsedRange.ClearContents
     .Range("A1:D1").Value = Array("Issue", "Date", "Qty", "value")
    End With
    
    rsht2 = ms.Range("A" & Rows.Count).End(xlUp).Row
    
    
    With mr
          rsht1 = .Range("A" & .Rows.Count).End(xlUp).Row
          For i = 3 To rsht1
                Do While .Cells(1, col).Value <> "" 'And .Cells(I, col).Value <> ""
                rsht2 = rsht2 + 1
               
                ms.Range("A" & rsht2).Value = .Range("A" & i).Value
                
                ms.Range("B" & rsht2).Value = .Cells(1, col).Value
                
                ms.Range("C" & rsht2).Value = .Cells(i, col).Value
                
                ms.Range("D" & rsht2).Value = .Cells(i, col2).Value
                
         
                col = col + 2
                col2 = col2 + 2
            Loop
            col = 2
            col2 = 3
        Next
    End With
    
  With ms
  
  


  
    .Columns("A:Z").EntireColumn.AutoFit
    
    End With
    
End Sub

 

[Peter_SSs]

I have a large dataset ..

If the data is very large, then you may find this faster.
For the moment, this code puts the results off to the right of the original data, but could be put wherever you want.
I have also made some assumptions - see under the first screen shot below.
Do any testing on a copy of your workbook.

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("A1").CurrentRegion.Value
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 4)
  For i = 3 To UBound(a, 1)
    For j = 2 To UBound(a, 2) Step 2
      k = k + 1
      b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j): b(k, 4) = a(i, j + 1)
    Next j
  Next i
  With Range("A1").Offset(, UBound(a, 2) + 1).Resize(, 4)
    .Offset(1).Resize(k).Value = b
    .Value = Array("Date", "Product", "Qty", "Value")
    .EntireColumn.AutoFit
  End With
End Sub

Original data in columns A:E, results of the above code in columns G:J

Excel 2016 (Windows) 32 bit
	A	B	C	D	E	F	G	H	I	J
1	Date	Product A	Product A	Product B	Product B		Date	Product	Qty	Value
2		Qty	Value	Qty	Value		1/09/2017	Product A	50	1000
3	1/09/2017	50	1000	40	800		1/09/2017	Product B	40	800
4	2/09/2017	60	1200	20	400		2/09/2017	Product A	60	1200
5							2/09/2017	Product B	20	400
6
Sheet1

Assumptions:
1. There are no completely empty rows or columns within the data.
2. Original headings occupy 2 rows as shown above.
3. All rows of data occupy the same number of columns. That is, you don't have 'staggered' data like the sample below. (If you do, post back with details and the code can be modified.)

Excel 2016 (Windows) 32 bit
	A	B	C	D	E	F	G
1	Date	Product A	Product A	Product B	Product B	Product C	Product C
2		Qty	Value	Qty	Value	Qty	Value
3	1/09/2017	50	1000	40	800
4	2/09/2017	10	800
5	3/09/2017	60	1200	20	400	80	200
Sheet2

 

[klllmmm]

If the data is very large, then you may find this faster.
For the moment, this code puts the results off to the right of the original data, but could be put wherever you want.
I have also made some assumptions - see under the first screen shot below.
Do any testing on a copy of your workbook.

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("A1").CurrentRegion.Value
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 4)
  For i = 3 To UBound(a, 1)
    For j = 2 To UBound(a, 2) Step 2
      k = k + 1
      b(k, 1) = a(i, 1): b(k, 2) = a(1, j): b(k, 3) = a(i, j): b(k, 4) = a(i, j + 1)
    Next j
  Next i
  With Range("A1").Offset(, UBound(a, 2) + 1).Resize(, 4)
    .Offset(1).Resize(k).Value = b
    .Value = Array("Date", "Product", "Qty", "Value")
    .EntireColumn.AutoFit
  End With
End Sub

Original data in columns A:E, results of the above code in columns G:J

Excel 2016 (Windows) 32 bit

	A	B	C	D	E	F	G	H	I	J
1	Date	Product A	Product A	Product B	Product B		Date	Product	Qty	Value
2		Qty	Value	Qty	Value		1/09/2017	Product A	50	1000
3	1/09/2017	50	1000	40	800		1/09/2017	Product B	40	800
4	2/09/2017	60	1200	20	400		2/09/2017	Product A	60	1200
5							2/09/2017	Product B	20	400
6

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

Assumptions:
1. There are no completely empty rows or columns within the data.
2. Original headings occupy 2 rows as shown above.
3. All rows of data occupy the same number of columns. That is, you don't have 'staggered' data like the sample below. (If you do, post back with details and the code can be modified.)

Excel 2016 (Windows) 32 bit

	A	B	C	D	E	F	G
1	Date	Product A	Product A	Product B	Product B	Product C	Product C
2		Qty	Value	Qty	Value	Qty	Value
3	1/09/2017	50	1000	40	800
4	2/09/2017	10	800
5	3/09/2017	60	1200	20	400	80	200

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet2
​

Thank you very much. Above code work perfectly for my sample data.

However i found that my real data is some what different to sample.

Date	CustomerCode	CustomerName	Product A	Product A	Product B	Product B
			Qty	Value	Qty	Value
01-09-2017	C100	Customer A	50	1000	40	800
01-09-2017	C200	Customer B	70	1400
02-09-2017	C100	Customer A	60	1200	20	400

<tbody>
</tbody>

There can be product quantities & Values with no values.
I need consider customer code & names also when stacking the data.

I'm looking for a output similar to this. I prefer to get the output into a new sheet as there are many product data columns.

Date	CustomerCode	CustomerName	Product	Qty	Value
01-09-2017	C100	Customer A	Product A	50	1000
01-09-2017	C100	Customer A	Product B	40	800
01-09-2017	C200	Customer B	Product A	50	1000
02-09-2017	C100	Customer A	Product A	60	1200
02-09-2017	C100	Customer A	Product B	20	400

<tbody>
</tbody>

Thank you very much for the effort you make..

 

[Peter_SSs]

Best not to fully quote long posts as it makes the thread harder to read/navigate and just occupies storage space needlessly. If you want to quote, quote small, relevant parts only - like I have done below.

There can be product quantities & Values with no values.

Ah, yes, I did mention that possibility/problem in my assumptions (3) above.

Try this version.

Sub Rearrange_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("A1").CurrentRegion.Value
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 6)
  For i = 3 To UBound(a, 1)
    For j = 4 To UBound(a, 2) Step 2
      If Len(a(i, j)) > 0 Then
      k = k + 1
        b(k, 1) = a(i, 1): b(k, 2) = a(i, 2): b(k, 3) = a(i, 3)
        b(k, 4) = a(1, j): b(k, 5) = a(i, j): b(k, 6) = a(i, j + 1)
      End If
    Next j
  Next i
  Sheets.Add After:=ActiveSheet
  With Range("A1").Resize(, UBound(b, 2))
    .Offset(1).Resize(k).Value = b
    .Value = Array("Date", "Customer Code", "Customer Name", "Product", "Qty", "Value")
    .EntireColumn.AutoFit
  End With
End Sub

 

[klllmmm]

Thank you very much, the code works perfectly.

What changes i should make to the VBA code, if i have another value "Doc No", that also need to be stacked.

Date	CustomerCode	CustomerName	Product A	Product A	Product A	Product B	Product B	Product B
			Qty	Value	Doc No	Qty	Value	Doc No
01-09-2017	C100	Customer A	50	1000	1	40	800	2
01-09-2017	C200	Customer B	70	1400	3
02-09-2017	C100	Customer A	60	1200	4	20	400	5

<tbody>
</tbody>

Below is my expected table.

Date	CustomerCode	CustomerName	Product	Qty	Value	Doc No
01-09-2017	C100	Customer A	Product A	50	1000	1
01-09-2017	C100	Customer A	Product B	40	800	2
01-09-2017	C200	Customer B	Product A	70	1400	3
02-09-2017	C100	Customer A	Product A	60	1200	4
02-09-2017	C100	Customer A	Product B	20	400	5

<tbody>
</tbody>

Highly appreciate if you can further help me on this.

Regards,
klllmmm

 

[Peter_SSs]

What changes i should make to the VBA code, if i have another value "Doc No", that also need to be stacked.

ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 7)
For j = 4 To UBound(a, 2) Step 3
b(k, 4) = a(1, j): b(k, 5) = a(i, j): b(k, 6) = a(i, j + 1): b(k, 7) = a(i, j + 2)

You will also need to change the line near the end that enters the headings on the new sheet. I'll leave you to make that change.

 

[Oeldere]

You did not reply on my solution.

You expand your question by adding new conditions.

It would be better if you show your (total) question, so the code don't need to change again for each question.

Having said that, you have to try to understand the code (although that is somethings difficult) so you can change the given code for other simular questions.

 

[klllmmm]

Thank you very much. This is so helpful.