Systematically add 150 more rows every 51 cells down

gaudrco

Board Regular
Joined
Aug 16, 2019
Messages
203
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?
 
Last edited:

Some videos you may like

Excel Facts

Whats the difference between CONCAT and CONCATENATE?
The newer CONCAT function can reference a range of cells. =CONCATENATE(A1,A2,A3,A4,A5) becomes =CONCAT(A1:A5)

Richard U

Active Member
Joined
Feb 14, 2006
Messages
377
Something like this...

Code:
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
 
Last edited:

gaudrco

Board Regular
Joined
Aug 16, 2019
Messages
203
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
 
Last edited:

Richard U

Active Member
Joined
Feb 14, 2006
Messages
377
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!

Code:
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

Board Regular
Joined
Aug 16, 2019
Messages
203
For some reason its still not working. No errors occur, just nothing happening.
 

Richard U

Active Member
Joined
Feb 14, 2006
Messages
377
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

Well-known Member
Joined
Mar 15, 2013
Messages
888
Office Version
2010
Platform
Windows
Your original "Competitor Comparison Data" sheet was set up for 48 reports of 50 rows each.
Based on that, try this
Code:
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

Board Regular
Joined
Aug 16, 2019
Messages
203
Works like a charm, No Sparks. Thank you

And thank you as well, Richard U
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
888
Office Version
2010
Platform
Windows
You're welcome, glad to have helped.
Mind if I ask why you are doing this ?
 

gaudrco

Board Regular
Joined
Aug 16, 2019
Messages
203
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,099,685
Messages
5,470,124
Members
406,681
Latest member
sachinmasurkar

This Week's Hot Topics

Top