Systematically add 150 more rows every 51 cells down

[gaudrco]

I have a sheet that has groups of 50 rows with a row to separate each group from the next. I would like to increase the amount of rows in each group by 150 (a total of 200).

So starting on cell ("D55") add 150 rows above D55:AA55, then go down 51 rows and repeat for cell ("D106") [add 150 rows above D106:AA106], then down 51 cells and repeat for ("D157"), and so on.

All the newly added rows should inherit the same formatting as the starting point.

Sheet name is ("Competitor Comparison Data")

How would you code this?

 

[Richard U]

Something like this...

Sub Add150Rows()
'
With Sheets("Competitor Comparison Data")
'
Dim lng_row As Long
lng_row = 1
Do Until .Cells(lng_row + 2, 1).Value = ""
    Do Until .Cells(lng_row, 1).Value = ""
        .Rows(lng_row & ":" & lng_row + 150).Select
        Selection.Insert Shift:=xlDown
        lng_row = lng_row + 150
    Loop
    lng_row = lng_row + 1
Loop
End With
End Sub

 

[gaudrco]

Nothing seems to be happening when I run this code. I put the code into a command button and tried to run it that way.

There were no error messages, just nothing happened

 

[Richard U]

Nothing seems to be happening when I run this code. I put the code into a command button and tried to run it that way.

There were no error messages, just nothing happened

Ah, sorry. Careless mistake!

Sub Add150Rows()
'
With Sheets("Competitor Comparison Data")
'
Dim lng_row As Long
lng_row = 1
Do Until .Cells(lng_row + 2, 1).Value = "" And .Cells(lng_row, 1).Value = ""
    If .Cells(lng_row, 1).Value = "" Then
        .Rows(lng_row & ":" & lng_row + 150).Select
        Selection.Insert Shift:=xlDown
        lng_row = lng_row + 151
    End If
    lng_row = lng_row + 1
Loop
End With
End Sub

 

[gaudrco]

For some reason its still not working. No errors occur, just nothing happening.

 

[Richard U]

For some reason its still not working. No errors occur, just nothing happening.

Step through the code using F8 and see what happens. Set Lng_Row = 49 instead of 1 for the purposes of testing.

 

[NoSparks]

Your original "Competitor Comparison Data" sheet was set up for 48 reports of 50 rows each.
Based on that, try this

Sub Insert150Rows()
    Dim i As Long, j As Long
j = 55  'last row of first report section
With Sheets("Competitor Comparison Data")
    For i = 1 To 48     'number of reports being expanded
        .Cells(j, "D").Resize(150, 24).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        j = j + 201     'original 50 plus new 150 plus 1 blank between reports
    Next i
End With
End Sub

 

[gaudrco]

Works like a charm, No Sparks. Thank you

And thank you as well, Richard U

 

[NoSparks]

You're welcome, glad to have helped.
Mind if I ask why you are doing this ?

 

[gaudrco]

The reports were designed to hold 50 features for comparisons across competitors. I have realized that 50 features may not be enough. I received competitor information from a colleague and they had far more than 50 features to compare. So I decided to increase the amount of features that the reports can hold to 200.