Inserting rows using a list of numbers

[steverv]

I have a spreadsheet with hundreds of rows and six columns (7 with total).
Once completed I need to insert a row for each column with data in. Each row
is a seperate project:e.g.
A B C D E
F Total
Project 1 £50 £100 £200 £400
£750

This row would need 4 blank rows inserting below the project number. I can
count the number of occupied cells, but cannot work out how to insert rows
using this info. Any ideas?

 

[Mike H]

Hi,

The code below will insert 4 blank rows at every name change in column A.
Right click your sheet tab, view code and paste it in and run it.

Sub InsertRows()
MyColumn = "A"
For X = Cells(Rows.Count, MyColumn).End(xlUp).Row To 2 Step -1
If Cells(X - 1, MyColumn) <> Cells(X, MyColumn) Then
Rows(X).Resize(4).Insert
End If
Next X
End Sub

Mike

 

[steverv]

Mike
I have a list of over 700 numbers that relate to the rows with data in them,
each of which is a project. Can this be used so the code picks up each number
and inserts rows based on these numbers? e.g.
Project Rows
No to Insert
Project 1 4
Project 2 2
Project 3 5
Project 4 2 etc..
Thanks
Steve

 

[Mike H]

Hi,

This assumes you have a header row. It will take the number from the right
of the text string in column A and insert that many rows.

Sub InsertRows()
MyColumn = "A"
For X = Cells(Rows.Count, MyColumn).End(xlUp).Row To 2 Step -1
If Cells(X - 1, MyColumn) <> Cells(X, MyColumn) Then
Rows(X).Offset(1).Resize(CLng(Mid(Cells(X, MyColumn), InStr(Cells(X,
MyColumn), " ") + 1))).Insert
Stop
End If
Next X
End Sub

Mike