Copy and paste string separated by commas

[rex759]

Hello,
The code below inserts x number of rows based on the number in column A. Then it copes the information (Columns C:E) from above down into the new rows. I want to add the location numbers from Column G at the same time. If there is more than one location in Column G, they are always separated by a comma (no spaces). When there is only one location number in Column G, I can get it to work. I am not sure how to go about grabbing the numbers between the commas.

<Before Macro>

HD Pro Test 154.xlsm
	A	B	C	D	E	F	G
1		LOCATION	#	ITEM	DESCRIPTION	QTY	2nd LOCATIONS
2	0	2807F05	101390	50-1692	1/4 REPLCMNT STP 3/8OD	15
3	2	3232A01	801669	86-7006	5' BI-FOLD DOOR HARDWA	15	1819Z01,1810Z01
4			801669	86-7006	5' BI-FOLD DOOR HARDWA
5			801669	86-7006	5' BI-FOLD DOOR HARDWA
6	0	1916Z01	100344558	100344558	I606 11/2 CXC 45 ELB W	15
7	3	4008D02	44618	BN-44618	*GALV PIPE 3/4 X 36	16	4719y01,2310Z01,1921543
8			44618	BN-44618	*GALV PIPE 3/4 X 36
9			44618	BN-44618	*GALV PIPE 3/4 X 36
10			44618	BN-44618	*GALV PIPE 3/4 X 36
11	0	2510D01	3589785	304932325	9X3/4" WOOL ROLLER COV	7
12	0	1817K05	803363	84-0293	KWIK #293 BRASS ROUND	4
Sheet22

<After Macro>

HD Pro Test 154.xlsm
	A	B	C	D	E	F	G
16		LOCATION	#	ITEM	DESCRIPTION	QTY	2nd LOCATIONS
17	0	2807F05	101390	50-1692	1/4 REPLCMNT STP 3/8OD	15
18	2	3232A01	801669	86-7006	5' BI-FOLD DOOR HARDWA	15	1819Z01,1810Z01
19		1810Z01	801669	86-7006	5' BI-FOLD DOOR HARDWA
20		1819Z01	801669	86-7006	5' BI-FOLD DOOR HARDWA
21	0	1916Z01	100344558	100344558	I606 11/2 CXC 45 ELB W	15
22	3	4008D02	44618	BN-44618	*GALV PIPE 3/4 X 36	16	4719y01,2310Z01,1921543
23		1921543	44618	BN-44618	*GALV PIPE 3/4 X 36
24		2310Z01	44618	BN-44618	*GALV PIPE 3/4 X 36
25		4719y01	44618	BN-44618	*GALV PIPE 3/4 X 36
26	0	2510D01	3589785	304932325	9X3/4" WOOL ROLLER COV	7
27	0	1817K05	803363	84-0293	KWIK #293 BRASS ROUND	4
Sheet22

'Information based on column number
 'Set the range length of the row
 Set r = Worksheets("Sheet2").Range("A:I")
 
 'macro starts at the bottom of the sheet
 LastRow = 76
 
 Worksheets("Sheet2").Select
 'Pick column to determine number of rows to add
 For n = LastRow To 1 Step -1
 temp = Range("A" & n)
 
    If (temp > 0) Then
        Rows(n + 1 & ":" & n + temp).Insert Shift:=xlDown
        'add C, D & E
        
        If temp = 1 Then
            Range("B" & n + 1) = Cells(n, "G")
            Range("C" & n + 1) = Cells(n, "C")
            Range("D" & n + 1) = Cells(n, "D")
            Range("E" & n + 1) = Cells(n, "E")
        End If
              
             If temp = 2 Then
                Range("C" & n + 1) = Cells(n, "C")
                Range("D" & n + 1) = Cells(n, "D")
                Range("E" & n + 1) = Cells(n, "E")
                Range("C" & n + 2) = Cells(n, "C")
                Range("D" & n + 2) = Cells(n, "D")
                Range("E" & n + 2) = Cells(n, "E")
             End If
        If temp = 3 Then
                Range("C" & n + 1) = Cells(n, "C")
                Range("D" & n + 1) = Cells(n, "D")
                Range("E" & n + 1) = Cells(n, "E")
                Range("C" & n + 2) = Cells(n, "C")
                Range("D" & n + 2) = Cells(n, "D")
                Range("E" & n + 2) = Cells(n, "E")
                Range("C" & n + 3) = Cells(n, "C")
                Range("D" & n + 3) = Cells(n, "D")
                Range("E" & n + 3) = Cells(n, "E")
        End If
    End If
  Next n

Any help is appreciated

 

[Fluff]

How about

Sub rex()
   Dim i As Long, Rws As Long
   
   With Worksheets("Sheet2")
      For i = .Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
         Rws = .Cells(i, 1).Value
         If Rws > 0 Then
            .Rows(i + 1).Resize(Rws).Insert
            .Range("C" & i).Resize(Rws + 1, 3).FillDown
            .Range("B" & i + 1).Resize(Rws).Value = Application.Transpose(Split(.Cells(i, 7).Value, ","))
         End If
      Next i
   End With
End Sub

 

[rex759]

Wow, much more elegant and efficient. Works perfectly. Thank you!

 

[Fluff]

You're welcome & thanks for the feedback.