VBA Insert Blank Rows based on Cell Value

ceytl

Board Regular
Joined
Jun 6, 2009
Messages
56
Office Version
  1. 2016
Platform
  1. Windows
I found this VBA code, but I cannot figure out how to add more than one row.

I need to add 28 rows.

Sub InsertBlankRowsBasedOnCellValue()

Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "A"
StartRow = 1
BlankRows = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False

With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "7771" Then
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

Thanks!
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,592
Office Version
  1. 2013
Platform
  1. Windows
Try this:
Note this new addition:
Resize(28)
VBA Code:
Sub InsertBlankRowsBasedOnCellValue()
'Modified  1/3/2021  3:05:09 AM  EST
Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "A"
StartRow = 1
BlankRows = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False

With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "7771" Then
.Cells(R + 1, Col).Resize(28).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub
 

ceytl

Board Regular
Joined
Jun 6, 2009
Messages
56
Office Version
  1. 2016
Platform
  1. Windows
Try this:
Note this new addition:
Resize(28)
VBA Code:
Sub InsertBlankRowsBasedOnCellValue()
'Modified  1/3/2021  3:05:09 AM  EST
Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long

Col = "A"
StartRow = 1
BlankRows = 1

LastRow = Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False

With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If .Cells(R, Col) = "7771" Then
.Cells(R + 1, Col).Resize(28).EntireRow.Insert Shift:=xlDown
End If
Next R
End With
Application.ScreenUpdating = True

End Sub

Thanks! Works perfect!

How would I change it to sheet "O" instead of active sheet?
 

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,592
Office Version
  1. 2013
Platform
  1. Windows
Try this:
VBA Code:
Sub InsertBlankRowsBasedOnCellValue()
'Modified  1/3/2021  3:47:17 AM  EST
Application.ScreenUpdating = False
Dim Col As Variant
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "A"
StartRow = 1
LastRow = Sheets("O").Cells(Rows.Count, Col).End(xlUp).Row

With Sheets("O")
    For R = LastRow To StartRow + 1 Step -1
        If .Cells(R, Col) = "7771" Then
            .Cells(R + 1, Col).Resize(28).EntireRow.Insert Shift:=xlDown
        End If
Next R
End With
Application.ScreenUpdating = True
End Sub
 
Solution

My Aswer Is This

Well-known Member
Joined
Jul 5, 2014
Messages
17,592
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Great to see your learning Excel.
 

ceytl

Board Regular
Joined
Jun 6, 2009
Messages
56
Office Version
  1. 2016
Platform
  1. Windows
Try this:
VBA Code:
Sub InsertBlankRowsBasedOnCellValue()
'Modified  1/3/2021  3:47:17 AM  EST
Application.ScreenUpdating = False
Dim Col As Variant
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "A"
StartRow = 1
LastRow = Sheets("O").Cells(Rows.Count, Col).End(xlUp).Row

With Sheets("O")
    For R = LastRow To StartRow + 1 Step -1
        If .Cells(R, Col) = "7771" Then
            .Cells(R + 1, Col).Resize(28).EntireRow.Insert Shift:=xlDown
        End If
Next R
End With
Application.ScreenUpdating = True
End Sub


Thank you!
 

Watch MrExcel Video

Forum statistics

Threads
1,130,146
Messages
5,640,392
Members
417,140
Latest member
whiteprose

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
Top