Insert Multiple Rows based on cell value

[IosifFlorin]

Hello everyone!

need your help with some lines of code; i was looking for this on the forum, there are some posts about adding rows, but this is a bit more specific as it implies looping specific data.

> The number of rows to add: based on value in cells in column G

> Where to add the rows: below each cell in column G, the number of rows depending on what number is in each cell in column G

> Starting with cell G4

An example: in G4 we have as value 6 --> add below 6 rows
in G11 (before adding the rows above it was G5) we have as value 2 --> add below it 2 rows , and so on...

Thank you for your help!

 

[Peter_SSs]

When inserting or deleting rows (or columns) it is usually easiest to work backwards.
Try this in a copy of your worksheet.

Sub Add_Rows()
  Dim r As Long
  
  Application.ScreenUpdating = False
  For r = Range("G" & Rows.Count).End(xlUp).Row To 4 Step -1
    If Cells(r, "G").Value > 0 Then Rows(r + 1).Resize(Cells(r, "G").Value).Insert
  Next r
  Application.ScreenUpdating = True
End Sub

 

[hiker95]

IosifFlorin,

Here is a macro solution for you to consider.

You can change the raw data worksheet name in the macro.

Sample raw data:

Excel 2007
	G
1
2
3
4	6
5	2
6	end
7
Sheet1

After the macro:

Excel 2007
	G
1
2
3
4	6
5
6
7
8
9
10
11	2
12
13
14	end
15
Sheet1

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Sub InsertRowsOnValue()
' hiker95, 10/21/2015, ME895532
Dim r As Long, lr As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, "G").End(xlUp).Row
  For r = lr To 4 Step -1
    If IsNumeric(.Cells(r, "G")) And .Cells(r, "G") > 0 Then
      .Rows(r + 1).Resize(.Cells(r, "G").Value).Insert
    End If
  Next r
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the InsertRowsOnValue macro.

 

[IosifFlorin]

Thank you both for the help!

works perfectly
thanks again

 

[hiker95]

IosifFlorin,

Thanks for the feedback.

You are very welcome. Glad we could help.

And, come back anytime.