Inserting new rows based on cell value, and copying data to the new rows

[Yann74]

Hi all,

I've been searching a solution to my issue on the board but could not find a working solution that covers my needs.
I'd really appreciate some help to come up with a VBA code that does the following:

I have an Excel file with multiple sheets. In a specific sheet called "xyz" I have data from columns A to BW. Row 1 is for data labels.
The number of rows is variable depending on the source data.

I'd need code to check if column C contains a number or if it's empty.
If it's empty, then proceed to next row.
If it contains a number, then the code should insert the corresponding number of rows below, while copying (and keeping the format) columns G to BW from the origin row to the newly inserted ones.
The loop should process all rows iteratively until there is no data in column A.

For example:
Cell C2 contains "2". Code should insert 2 new rows under row 2 (so 3 and 4) and should copy G2:BW2 to G3:BW3 and G4:BW4 .

Cell C3 (now C5 after the previous rows have been inserted) contains "3". Code should insert 3 new rows under row 5 (so 6, 7 and 8) and should copy G5:BW5 to G6:BW6, G7:BW7 and G8:BW8.

Cell C9 and the the entire row 9 have no data, so the loop should stop.

Many thanks in advance for your kind help!
Yann.

 

[badboybebe]

Book1
	A	B	C	D	E
2	1	10	111001001105	Jefferson JfyBlk/ShlWht M10	M10
3	2		111001001105	Jefferson JfyBlk/ShlWht M10	M10
4	3		111001001105	Jefferson JfyBlk/ShlWht M10	M10
5	4		111001001105	Jefferson JfyBlk/ShlWht M10	M10
6	5		111001001105	Jefferson JfyBlk/ShlWht M10	M10
7	6		111001001105	Jefferson JfyBlk/ShlWht M10	M10
8	7		111001001105	Jefferson JfyBlk/ShlWht M10	M10
9	8		111001001105	Jefferson JfyBlk/ShlWht M10	M10
10	9		111001001105	Jefferson JfyBlk/ShlWht M10	M10
11	10		111001001105	Jefferson JfyBlk/ShlWht M10	M10
12	1	6	111001001105	Jefferson JfyBlk/ShlWht M11	M11
13	2		111001001105	Jefferson JfyBlk/ShlWht M11	M11
14	3		111001001105	Jefferson JfyBlk/ShlWht M11	M11
15	4		111001001105	Jefferson JfyBlk/ShlWht M11	M11
16	5		111001001105	Jefferson JfyBlk/ShlWht M11	M11
17	6		111001001105	Jefferson JfyBlk/ShlWht M11	M11
Sheet1

Really? I think its almost the same
Here is what i want my data become. Or at least seperate number in column B into row. Example 10 means 10 row, 6 means 6 row

 

[Peter_SSs]

so that I can see just .... and where they should be.

I'm not sure that you have shown me that, or perhaps it was the location of the original data? Anyway, all I can go on is what you have shown so try this with a copy of your workbook. If the locations of original data and results are as you have shown then the results will over-write, or part over-write, the original data if the results require more than 20 rows.

Sub ExpandRows()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  a = Range("B23", Range("E" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To Rows.Count, 1 To 5)
  For i = 1 To UBound(a)
    For j = 1 To a(i, 1)
      k = k + 1
      b(k, 1) = j
      If j = 1 Then b(k, 2) = a(i, 1)
      b(k, 3) = a(i, 2): b(k, 4) = a(i, 3): b(k, 5) = a(i, 4)
    Next j
  Next i
  Range("A2").Resize(k, UBound(b, 2)).Value = b
End Sub

 

[badboybebe]

I cant copy mini sheet so i send picture. The macro worked. But it only work with the last row.
Sorry for copy too little data for you. My data has column to W, and thousand of row.
Can we copy into a new sheet instead of overwrite the data row below?

 

[Peter_SSs]

The macro worked. But it only work with the last row.

You showed in post #9 that your data actually started in row 23 so I wrote the code for that, but it appears you tested it on data that started in row 2.

My data has column to W, and thousand of row.

1. Do you have thousands of rows before the code runs or are you just saying there will be thousands of rows after the code has run?
   
   
2. Do you have any formulas on the sheet or is everything just constant text or numerical values?
   
   
3. Can you confirm whether column A has nothing in it before the code runs like the top image in your latest post or already contains 'Ctn No' data as shown in the bottom image?

 

[badboybebe]

I cant copy mini sheet so i send picture. The macro worked. But it only work with the last row.
Sorry for copy too little data for you. My data has column to W, and thousand of row.
Can we copy into a new sheet instead of overwrite the data row below?

Or for more simple
Ignore all the other data and column. Can we just make row like the picture below. Column B is determine how many row will be. Copy into same sheet, new sheet or even another column like image is okay
Please help me !

 

[badboybebe]

You showed in post #9 that your data actually started in row 23 so I wrote the code for that, but it appears you tested it on data that started in row 2.

1. Do you have thousands of rows before the code runs or are you just saying there will be thousands of rows after the code has run?
   
   
2. Do you have any formulas on the sheet or is everything just constant text or numerical values?
   
   
3. Can you confirm whether column A has nothing in it before the code runs like the top image in your latest post or already contains 'Ctn No' data as shown in the bottom image?

Ah yes, its works on row 23. So if i want to delete upper row, i will change code into new start position. And with data has W column, i will change Range"E" into Range"W", can I ?

Please ignore upper post, i did not know you answered me.

Great great great thanks !!!!

 

[Peter_SSs]

And with data has W column, i will change Range"E" into Range"W", can I ?

That will not be enough by itself, other changes will also be needed.
If you still need help with this, please answer my 3 questions?

 

[badboybebe]

That will not be enough by itself, other changes will also be needed.
If you still need help with this, please answer my 3 questions?

Yes, I have just tested and it did not work

1. The number of rows will change in each file. This time is has 1354 rows.
2. There is no fomula.
3. The column Ctn No is no use for me. I can delete it

 

[Peter_SSs]

See if this is any use. Test with a copy of your workbook.
I have assumed that your headings are on row 22 with data starting on row 23 as you showed earlier.

Sub ExpandRows_v2()
  Dim r As Long, Rws As Long
  
  Application.ScreenUpdating = False
  ActiveSheet.Copy After:=ActiveSheet
  With ActiveSheet
    .Rows("1:21").Delete
    For r = Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
      Rws = .Cells(r, 2).Value
      If Rws > 1 Then
        .Rows(r + 1).Resize(Rws - 1).Insert
        .Range("C" & r).Resize(, 21).Copy Destination:=.Range("C" & r).Resize(Rws)
      End If
    Next r
    With .Range("A2:A" & .Range("C" & Rows.Count).End(xlUp).Row)
      .FormulaR1C1 = "=IF(RC[1]="""",R[-1]C+1,1)"
      .Value = .Value
      .Cells(0).Value = "No"
    End With
  End With
  Application.ScreenUpdating = True
End Sub

 

[badboybebe]

Whaooooo
Love to see it works. Even with new file. What i need to do is copy from row 21 then paste into new file with same row 21
Really really THANKS much