create Multiple Rows per line item

[peedeebee]

Hello, I am trying to convert some data currently exported as below:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Order Number[/TD]
[TD]SKU[/TD]
[TD]Price[/TD]
[/TR]
[TR]
[TD]Order1[/TD]
[TD]sku1,sku2[/TD]
[TD]$1,$2[/TD]
[/TR]
[TR]
[TD]Order2[/TD]
[TD]sku3,sku4[/TD]
[TD]$1,$2[/TD]
[/TR]
</tbody>[/TABLE]

We need this transformed in excel into something like the below:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Order Number[/TD]
[TD]SKU[/TD]
[TD]Price[/TD]
[/TR]
[TR]
[TD]Order1[/TD]
[TD]sku1[/TD]
[TD]$1[/TD]
[/TR]
[TR]
[TD]Order1[/TD]
[TD]sku2[/TD]
[TD]$2[/TD]
[/TR]
[TR]
[TD]Order2[/TD]
[TD]sku3[/TD]
[TD]$1[/TD]
[/TR]
[TR]
[TD]Order2[/TD]
[TD]sku4[/TD]
[TD]$2[/TD]
[/TR]
</tbody>[/TABLE]

Any help would be greatly appreciated!

Thanks!

 

[sheetspread]

Try this:

Excel 2010
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Order Number	Order Items Product Master SKU	Qty	Prices	Ship Name	Ship Company	Ship Address1	Ship Address2	Ship Address 3	Ship City	Ship State	Ship Zip Code	Ship Country	Ship Phone
2	MTW1617	PPP4,PPI4WPDQ6	1,2	11.95,12.95	TEST	TEST	123 Fake Street	Unit 1		COLUMBUS	OH	43214-1586	US	0
3	TEST062718	CFK9W,PPP4,PPI4W	1,2,3	11.95,12.95,10.95	TEST	TEST	123 Fake Street	Unit 1		Toronto	ontario	m3j2m5	CA	6479514813
4	MTW1617	PPP4,PPI4WPDQ6	1,2	11.95,12.95	TEST	TEST	123 Fake Street	Unit 1		COLUMBUS	OH	43214-1586	US	0
Sheet2 (6)

Sub morerows()
Dim i%, j%, x%, arr As Variant
i = 2
Do Until Cells(i, 1) = ""
x = Len(Cells(i, 2)) - Len(Replace(Cells(i, 2), ",", ""))
If x > 0 Then
ReDim arr(x)
Cells(i + 1, 1).Resize(x).EntireRow.Insert
Cells(i + 1, 1).Resize(x, 14).Value = Cells(i, 1).Resize(, 14).Value
For j = 2 To 4
arr = Split(Cells(i, j), ",")
Cells(i, j).Resize(x + 1) = Application.Transpose(arr)
Next j
Else
End If
i = i + x + 1
Loop
End Sub

Excel 2010
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1	Order Number	Order Items Product Master SKU	Qty	Prices	Ship Name	Ship Company	Ship Address1	Ship Address2	Ship Address 3	Ship City	Ship State	Ship Zip Code	Ship Country	Ship Phone
2	MTW1617	PPP4	1	11.95	TEST	TEST	123 Fake Street	Unit 1		COLUMBUS	OH	43214-1586	US	0
3	MTW1617	PPI4WPDQ6	2	12.95	TEST	TEST	123 Fake Street	Unit 1		COLUMBUS	OH	43214-1586	US	0
4	TEST062718	CFK9W	1	11.95	TEST	TEST	123 Fake Street	Unit 1		Toronto	ontario	m3j2m5	CA	6479514813
5	TEST062718	PPP4	2	12.95	TEST	TEST	123 Fake Street	Unit 1		Toronto	ontario	m3j2m5	CA	6479514813
6	TEST062718	PPI4W	3	10.95	TEST	TEST	123 Fake Street	Unit 1		Toronto	ontario	m3j2m5	CA	6479514813
7	MTW1617	PPP4	1	11.95	TEST	TEST	123 Fake Street	Unit 1		COLUMBUS	OH	43214-1586	US	0
8	MTW1617	PPI4WPDQ6	2	12.95	TEST	TEST	123 Fake Street	Unit 1		COLUMBUS	OH	43214-1586	US	0
Sheet2 (6)

 

[peedeebee]

Awesome! You're the man! Is there some code can be added which will run this every 5 minutes and deposit the formatted data into a new worksheet?

 

[peedeebee]

Hi JoeMo - OK I have amended your VBA code to include a 4th column. Here is the sample data:

Book1
	A	B	C	D
1	Order Number	Order Items Product Master SKU	Qty	Prices
2	MTW1617	PPP4,PPI4WPDQ6	1, 2	11.95,12.95
3	TEST062718	CFK9W,PPP4,PPI4W	1, 2, 3	11.95,12.95,10.95
4	MTW1617	PPP4,PPI4WPDQ6	1, 2	11.95,12.95
5	MTW1618	PPP4,PPI4WPDQ6	1, 2	11.95,12.95
6	TEST062718	CFK9W,PPP4,PPI4W	1,2,4	29.95,10.95,9.95
7	TEST062818	CFK9W,PPP4,PPI4W	10,5,6	12.95,9.95,8.95
8	MTW1619	CFK9W	1	29.95
9	TEST0628182	CFK9W,PPP4,PKA1	5,2,4	29.95,10.95,8.95
UPS_CUSTOMS

Here is the output on the same worksheet:

Book1
	F	G	H	I
1	Order Number	Order Items Product Master SKU	Qty	Prices
2	MTW1617	PPP4	1	11.95
3	MTW1617	PPI4WPDQ6	2	12.95
4	TEST062718	CFK9W	1	11.95
5	TEST062718	PPP4	2	12.95
6	TEST062718	PPI4W	3	10.95
7	MTW1617	PPP4	1	11.95
8	MTW1617	PPI4WPDQ6	2	12.95
9	MTW1618	PPP4	1	11.95
10	MTW1618	PPI4WPDQ6	2	12.95
11	TEST062718	CFK9W	1	29.95
12	TEST062718	PPP4	2	10.95
13	TEST062718	PPI4W	4	9.95
14	TEST062818	CFK9W	10	12.95
15	TEST062818	PPP4	5	9.95
16	TEST062818	PPI4W	6	8.95
17	MTW1619	CFK9W	1
18	TEST0628182	CFK9W	5	29.95
19	TEST0628182	PPP4	2	10.95
20	TEST0628182	PKA1	4	8.95
UPS_CUSTOMS

Notice how row 17 is not populating - this is because there was only one price, instead of multiple separated by comma. Is there an IF statement I can add which will still populate the price if it is only singular?

Can I have this post the output into a new worksheet, instead of the same? Is there a way to have this macro run automatically every 5 minutes?

Thank you for all your help!

This is the VBA code I am using:

Sub RearrangeData()Dim R As Range, c As Range, nxRw As Long, V1 As Variant, V2 As Variant, V3 As Variant
Set R = Range("A1:D" & Cells(Rows.Count, "A").End(xlUp).Row)
Application.ScreenUpdating = False
Range("F:I").ClearContents
With Range("F1:I1")
    .Value = R.Rows(1).Cells.Value
    .EntireColumn.AutoFit
End With
For Each c In R.Offset(1, 0).Resize(R.Rows.Count - 1).Columns(1).Cells
    V1 = Split(c.Offset(0, 1).Value, ",")
    V2 = Split(c.Offset(0, 2).Value, ",")
    V3 = Split(c.Offset(0, 3).Value, ",")
    nxRw = Range("F" & Rows.Count).End(xlUp).Row + 1
    If UBound(V1) > 0 Then
        With Range("F" & nxRw)
            .Resize(UBound(V1) + 1).Value = c.Value
            For i = LBound(V1) To UBound(V1)
                .Offset(i, 1).Value = V1(i)
                .Offset(i, 2).Value = V2(i)
                .Offset(i, 3).Value = V3(i)
            Next i
'            .Offset(0, 2).Resize(UBound(V) + 1).Value = c.Offset(0, 2).Value
        End With
    Else
        Range("F" & nxRw).Resize(1, 3).Value = c.Resize(1, 3).Value
    End If
Next c
Application.ScreenUpdating = True
End Sub

 

[Rick Rothstein]

Here is another macro that you can try...

[table="width: 500"]
[tr]
	[td]Sub RedistributeData()
  Dim X As Long, LastRow As Long, CellVal As String, Data() As String
  Dim A As Range, Table As Range, Col As Range
  Const Delimiter As String = ","
  Const DelimitedColumn As String = "B:D"
  Const TableColumns As String = "A:N"
  Const StartRow As Long = 2
  Application.ScreenUpdating = False
  LastRow = Columns(TableColumns).Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  For X = LastRow To StartRow Step -1
    CellVal = Cells(X, Range(DelimitedColumn)(1).Column).Value
    If CellVal Like "*,*" Then
      Intersect(Rows(X + 1), Columns(TableColumns)).Resize(Len(CellVal) - Len(Replace(CellVal, ",", ""))).Insert xlShiftDown
    End If
    For Each Col In Range(DelimitedColumn).Columns
      Data = Split(Cells(X, Col.Column), Delimiter)
      If Len(Cells(X, Col.Column)) Then
        Cells(X, Col.Column).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
      End If
    Next
  Next
  LastRow = Cells(Rows.Count, Range(DelimitedColumn).Columns(1).Column).End(xlUp).Row
  On Error Resume Next
  Set Table = Intersect(Columns(TableColumns), Rows(StartRow).Resize(LastRow - StartRow + 1))
  If Err.Number = 0 Then
    Table.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    Columns(DelimitedColumn).SpecialCells(xlFormulas).Clear
    Table.Value = Table.Value
  End If
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub[/td]
[/tr]
[/table]

 

[JoeMo]

Hi JoeMo - OK I have amended your VBA code to include a 4th column. Here is the sample data:




Notice how row 17 is not populating - this is because there was only one price, instead of multiple separated by comma. Is there an IF statement I can add which will still populate the price if it is only singular?

Can I have this post the output into a new worksheet, instead of the same? Is there a way to have this macro run automatically every 5 minutes?

Thank you for all your help!

Your amendment missed a critical line. Now that you have 4 columns of data this bit:

Else
Range("F" & nxRw).Resize(1, 3).Value = c.Resize(1, 3).Value

should have a 4 in place of the red 3.

You can alter the code to put the rearranged data in another sheet. Look into Application.OnTime to run the macro every 5 minutes.

 

[peedeebee]

That's the one! Thank you JoeMo!