Converting data Wide to long with dates

[joseulloa22]

Hello,
I was trying to convert the following table

ITEM_NAME	7/30/2018	8/27/2018	10/1/2018	10/29/2018
1690ZZ	130	162	162	162
1692ZK	72	70	171	70

<colgroup><col width="94" style="width: 71pt; mso-width-source: userset; mso-width-alt: 3437;"> <col width="85" style="width: 64pt; mso-width-source: userset; mso-width-alt: 3108;"> <col width="68" style="width: 51pt; mso-width-source: userset; mso-width-alt: 2486;" span="2"> <col width="75" style="width: 56pt; mso-width-source: userset; mso-width-alt: 2742;"> <tbody> </tbody>

........ ..... ..... ....... .....



into

1690ZZ	7/30/2018	130
1690ZZ	8/27/2018	162
1690ZZ	10/1/2018	162
1690ZZ	10/29/2018	162
1692ZK	7/30/2018	72
1692ZK	8/27/2018	70
1692ZK	10/1/2018	171
1692ZK	10/29/2018	70

<colgroup><col width="94" style="width: 71pt; mso-width-source: userset; mso-width-alt: 3437;"> <col width="85" style="width: 64pt; mso-width-source: userset; mso-width-alt: 3108;"> <col width="68" style="width: 51pt; mso-width-source: userset; mso-width-alt: 2486;"> <tbody> </tbody>

This is an example but my table has more data. Your wisdom is greatly appreciated

 

[Peter_SSs]

Assuming the table starts at A1, give this a try in a copy of your workbook.

Sub Rearrange()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, ub2 As Long
  
  With Range("A1").CurrentRegion
    a = .Value
    ub2 = UBound(a, 2)
    ReDim b(1 To (UBound(a, 1) - 1) * (ub2 - 1), 1 To 3)
    For i = 2 To UBound(a)
      For j = 2 To ub2
        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
    .Offset(.Rows.Count + 3).Resize(k, 3).Value = b
  End With
End Sub

 

[joseulloa22]

Hi Peter
This is great. It worked and worked fantastic. Question, is there any way to make the new table comes up in a new sheet, say starting in cell A1?

Thank you again!
Jose Ulloa

 

[Peter_SSs]

.. is there any way to make the new table comes up in a new sheet, say starting in cell A1?

Try something like this

Sub Rearrange_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, ub2 As Long
  
  a = Range("A1").CurrentRegion.Value
  ub2 = UBound(a, 2)
  ReDim b(1 To (UBound(a, 1) - 1) * (ub2 - 1), 1 To 3)
  For i = 2 To UBound(a)
    For j = 2 To ub2
      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
  Sheets.Add After:=ActiveSheet
  With Range("A1:C1")
    .Value = Array("Item", "Date", "Value")
    .Rows(2).Resize(k).Value = b
    .EntireColumn.AutoFit
  End With
End Sub

 

[joseulloa22]

Peter, thanks again. This is of great help!

Jose

 

[Peter_SSs]

You are very welcome.

 

[joseulloa22]

Peter, sorry to bother you again. Can you make the output look like the following? Change/Added new columns with headers name

	A	B	C	D	E	F	G	H
1	ITEM_NAME	ORGANIZATION_CODE	FORECAST_DESIGNATOR	FORECAST_DATE	FORECAST_END_DATE	QUANTITY	CONFIDENCE_PERCENTAGE	BUCKET_TYPE
2	1690ZZ			30-Jul-2018		130
3	1690ZZ			27-Aug-2018		162
4	1690ZZ			1-Oct-2018		162
5	1690ZZ			29-Oct-2018		162
6	1690ZZ			26-Nov-2018		162
	1690ZZ			31-Dec-2018		162

<tbody>
</tbody>

 

[Peter_SSs]

Can you make the output look like the following?

Replace the code between the blue rows with the code shown below.

  Next i
  Application.ScreenUpdating = False
  Sheets.Add After:=ActiveSheet
  Range("A2:C2").Resize(k).Value = b
  Columns("C").Insert
  Columns("B:C").Insert
  Range("A1:H1").Value = Split("ITEM_NAME ORGANIZATION_CODE FORECAST_DESIGNATOR FORECAST_DATE FORECAST_END_DATE QUANTITY CONFIDENCE_PERCENTAGE BUCKET_TYPE")
  Columns("A:H").AutoFit
  Application.ScreenUpdating = True
End Sub

 

[joseulloa22]

Phenomenal. This is truly marvelous!

Thanks much for your help Peter!

Jose

 

[joseulloa22]

Peter, is there any good Excel VBA book for beginners you can recommend? I am just fascinated!
Jose