insert rows based on a cell's value (macro)

[Shoney]

Hello,

I'm trying to write a macro that will insert a number of rows based on a
cell's value.

For example, if the value of a cell in column "U", beginning w/ "U2", is 2,
insert one row under it. Then, go to the next integer in column "U" (in this
case, "U4". I would like for the macro to repeat until there is no longer a
value in column "U".

Note: If the value in "U" is 1, then no rows would need to be inserted.

The code that I have so far is as follows:

Sub AddMultitipleRows()

If Range("U2") > 1 Then
'Insert that number of rows
Rows.Insert Shift:=xlDown
End If

Do Until ActiveCell.Value = 0
ActiveCell.Offset(1, 0).Select
Loop

End Sub

I appreciate any help you can provide.

Thank you.

 

[Dave Peterson]

It's lots easier if you start at the bottom and work your way up:

Option Explicit
Sub AddMultitipleRows2()

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim wks As Worksheet

Set wks = ActiveSheet

With wks
FirstRow = 2
LastRow = .Cells(.Rows.Count, "U").End(xlUp).Row

For iRow = LastRow To FirstRow Step -1
With .Cells(iRow, "U")
If IsNumeric(.Value) Then
If .Value > 1 Then
.Offset(1, 0).Resize(.Value).EntireRow.Insert
End If
End If
End With
Next iRow
End With

End Sub

 

[Joel]

Sub AddMultitipleRows()
LastRow = Range("U" & Rows.Count).End(xlup).Row
RowCount = LastRow
Do while RowCount >= 1
If Range("U2") > 1 Then
Rows((RowCount + 1) & ":" & (RowCount + Range("U2")) ).Insert
End If
RowCount = RowCount - 1
Loop
End Sub