VBA to Insert Rows in List

happyhungarian

Board Regular
Joined
Jul 19, 2011
Messages
247
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have a list to names beginning in cell C9 that can vary in length. Once my list is established I need to insert 5 rows between each record in the list. I'm sure there's probably an easy way to do this but I can't figure it out.

Thank you for your help.

J
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Try

Rich (BB code):
Sub InsertRows()
Dim lr As Long, i As Long, MyCol As String

MyCol = "A" 'Adjust to the appropriate column containing the list
lr = Cells(Rows.Count, MyCol).End(xlUp).Row

For i = lr To 3 Step -1 'Change the 3 to 2 if your list does not have a header row.
    Rows(i).Resize(5).EntireRow.Insert
Next i
End Sub
 
Upvote 0
Thanks. It works perfectly if the header of the list is in Row 1 but if it starts down the page a bit then it inserts a bunch of rows above the list as well as between the records. Is there a way to have it recognize that the list starts in a particular row?
 
Upvote 0
Try

Rich (BB code):
Sub InsertRows()
Dim lr As Long, i As Long, MyCol As String
MyCol = "A" 'Adjust to the appropriate column containing the list

lr = Cells(Rows.Count, MyCol).End(xlUp).Row
fr = Columns(MyCol).Find("Header").Row + 2 'Adjust the name of the header

For i = lr To fr Step -1
    Rows(i).Resize(5).EntireRow.Insert
Next i
End Sub
 
Upvote 0
Actually had one follow-on question... is it possible to also have the macro auto-insert verbage into the new cells it creates? So for example, the first row out of the 5 it inserts it will paste the words "ID#", the second row would have "address", and so on for each of the records that were in the original list? So it would look the like following:

Header
Original list item 1
ID#
Address
etc3
etc4
etc5
Original list item 2
ID#
Address

and so on?
 
Upvote 0
Try
Code:
Sub InsertRows()
Dim lr As Long, fr As Long, i As Long
Dim MyCol As String, MyVals As Variant

MyCol = "A" 'Adjust to the appropriate column containing the list
MyVals = Array("ID", "Address", "Etc1", "Etc2", "Etc3")
lr = Cells(Rows.Count, MyCol).End(xlUp).Row + 1
fr = Columns(MyCol).Find("Header").Row + 2 'Adjust the name of the header

For i = lr To fr Step -1
    Rows(i).Resize(5).EntireRow.Insert
    Cells(i, MyCol).Resize(5, 1).Value = Application.Transpose(MyVals)
Next i
End Sub
 
Upvote 0

Forum statistics

Threads
1,211,839
Messages
6,104,292
Members
447,901
Latest member
boy3hc2004

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top