Macro insert rows depending on # in Column B

[Splendalisa]

HI,
I have this spreadsheet named Test and the # for the number of rows I want
inserted below this line is in Column B. Can you tell me the VBA to get this
done?
Here is example:

A B
;laskdjf;alskdjf;lskj
lskdjf;lskdfj;alskj
laskjf;sldfksj
a;sldkfjds;l 4

lskdjf;lskdjf;slk
alsdkjf;alsdkfj
lasdjfs;ldfkj 3

a;sldkfjs;lkfj
;alsdkjf;alskdfj
;alsdkfja;sdkflj
a;lskdjf;lsadkf 3

a;sldkfj;asdlkfj
;alskfjdf;alskj

l;aksdjf;alsdkjf 2

 

[paul.robinson]

Hi
Assuming your data starts in cell A1 then this should do

Sub tester()
Dim TargetRange As Range
Dim TempValue As Integer, i As Integer, j As Integer
Set TargetRange = Range("A1").CurrentRegion
With TargetRange
For i = .Rows.Count To 1 Step -1
TempValue = .Cells(i, 2).Value
If TempValue > 0 Then
For j = 1 To TempValue
.Rows(i + 1).Insert Shift:=xlDown
Next j
End If
Next i
End With
Set TargetRange = Nothing
End Sub

As with any sub that changes a Range, you start from the bottom and
work your way up to insert rows
regards
Paul

 

[Jay]

Hi Splenda -

Sub splenda()
'Check Column B, Row 1 for non-zero value
If Cells(1, 2).Value > 0 Then Cells(1, 2). _
Offset(1, 0).EntireRow.Insert _
(Cells(1, 2).Value)

'Capture last entry in column B
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Cells(LastRow, 2).Activate

'Loop upward thru cells in ColB; insert as needed
Do Until ActiveCell.Row = 1
If ActiveCell.Value > 0 Then
For i = 1 To ActiveCell.Value
ActiveCell.Offset(1, 0).EntireRow.Insert
Next i
End If
ActiveCell.Offset(-1, 0).Activate
Loop
End Sub

 

[Jay]

Hi Splenda -

Here's an updated version that correctly addresses the case where there is a
control value in row 1, column B. My previous post did not address that case
properly:

Sub splenda()
'Capture row of last entry in column B
ctrlValueRow = Cells(Rows.Count, "B").End(xlUp).Row
'Loop upward thru cells in ColB; insert as needed
Do While ctrlValueRow > 0
Cells(ctrlValueRow, 2).Activate
If ActiveCell.Value > 0 Then
For i = 1 To ActiveCell.Value
ActiveCell.Offset(1, 0).EntireRow.Insert
Next i
End If
ctrlValueRow = ctrlValueRow - 1
Loop
End Sub

 

[Splendalisa]

Thanks so much. Works Great!