Insert multiple rows

[sdg8481]

Hi,

I have a excel workbook that i need to insert a number of rows based on a
value in a cell, for example;

A1 B1
Bob Smith 5
John Smith 3

I need to insert another 4 rows below bob smith (to give 5 in total) and
another 2 rows below John Smith (to make 3 in total), etc.....

Is this possible, any ideas?????

Thanks in advance

 

[Dave Peterson]

Option Explicit
Sub testme()
Dim wks As Worksheet
Dim iRow As Long
Dim HowManyRows As Variant
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Sheet1")
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
HowManyRows = .Cells(iRow, "B").Value
If IsNumeric(HowManyRows) Then
'some minor testing
If HowManyRows > 1 _
And HowManyRows < 100 Then
.Rows(iRow + 1).Resize(HowManyRows - 1).Insert
'do you want the names copied down to the
'inserted rows?
'.Cells(iRow + 1, "A").Resize(HowManyRows - 1).Value _
' = .Cells(iRow, "A").Value
End If
End If
Next iRow
End With

End Sub


If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

 

[sdg8481]

Thats absolutely brilliant. Thank You very much. However, just to be cheeky
is there a away where i can copy all the contents of the original row down
into the new row, i see you've done it for column A, but how do i convert
that for the whole row?

Thanks again

 

[Dave Peterson]

Maybe...

Option Explicit
Sub testme()
Dim wks As Worksheet
Dim iRow As Long
Dim HowManyRows As Variant
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Sheet1")
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
HowManyRows = .Cells(iRow, "B").Value
If IsNumeric(HowManyRows) Then
'some minor testing
If HowManyRows > 1 _
And HowManyRows < 100 Then
.Rows(iRow + 1).Resize(HowManyRows - 1).Insert
.Rows(iRow).Copy _
Destination:=.Cells(iRow + 1, "A") _
.Resize(HowManyRows - 1, 1)
End If
End If
Next iRow
End With

End Sub

 

[sdg8481]

perferct. Thank You

Maybe...

Option Explicit
Sub testme()
Dim wks As Worksheet
Dim iRow As Long
Dim HowManyRows As Variant
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Sheet1")
With wks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
For iRow = LastRow To FirstRow Step -1
HowManyRows = .Cells(iRow, "B").Value
If IsNumeric(HowManyRows) Then
'some minor testing
If HowManyRows > 1 _
And HowManyRows < 100 Then
.Rows(iRow + 1).Resize(HowManyRows - 1).Insert
.Rows(iRow).Copy _
Destination:=.Cells(iRow + 1, "A") _
.Resize(HowManyRows - 1, 1)
End If
End If
Next iRow
End With

End Sub