After Every Tenth Row Insert 2 Blank Rows without any Format

[ameenuksg]

Hi I have recorded the following Macro but it seems to insert another extra row(third row) with format which I did not intend to record:

Sub Macro5()
'
' Macro5 Macro
'

'
ActiveCell.Range("A1:A10").Select
ActiveWindow.SmallScroll Down:=3
ActiveCell.Offset(10, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlDown
Selection.ClearFormats
ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveWindow.SmallScroll Down:=3
ActiveCell.Offset(1, 0).Range("A1").Select
End Sub


Anyone able to help me correct the above macro to insert 2 blank rows only after the 10th row without any format and then select the next row after the 2 blank rows ?

 

[My Aswer Is This]

Your subject title says Insert after every tenth row
But then you say after row 10

This script inserts 2 rows after row 10 and stops

Sub Test()
'Modified 6/20/2018 9:15 PM  EDT
Application.ScreenUpdating = False
Rows(10).Offset(1).Resize(2).Insert xlShiftDown
Rows(13).Select
Application.ScreenUpdating = True
End Sub

If you want it after every tenth row then you need to explain more.

Like how do we know when to stop. We have 1.5 million rows and to insert 2 rows after every tenth row would mean row:

10
20
30
40
50
on and on to row 1 million 500 thousand

 

[ameenuksg]

Thank you so much for your response.

1. Would like the macro to insert 2 blank row without any format after every 10th row of data from row 2 on column a

2. Would like it to stop if there arent any rows of data

 

[My Aswer Is This]

Try this:

Sub Insert_Rows()
'Modified 6/20/2018 10:00 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For i = Lastrow To 1 Step -10
    Rows(i).Offset(1).Resize(2).Insert xlShiftDown
Next
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row + 2
Application.Goto Cells(Lastrow, 1), True
Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another option

Sub Insertrws()
   Dim lr As Long, i As Long
   lr = Range("A" & Rows.count).End(xlUp).row
   For i = (Int(lr / 10) * 10) + 1 To 11 Step -10
      Rows(i + 1).Resize(2).Insert
   Next i
End Sub

 

[ameenuksg]

Hi All

Both codes are working great but both the inserted rows are with format of the above or below rows. Anyway to clear any formats of both inserted rows ?

 

[Fluff]

How about

Sub Insertrws()
   Dim lr As Long, i As Long
   lr = Range("A" & Rows.Count).End(xlUp).row
   For i = (Int(lr / 10) * 10) + 1 To 11 Step -10
      Rows(i + 1).Resize(2).Insert
      Rows(i + 1).Resize(2).Clear
   Next i
End Sub

 

[ameenuksg]

Thank you so much, its working wonders for me. I was thinking if its possible to make VBA stop inserting blank rows if there are only 15 rows of data left ahead in the sheet towards the end or there are only 15 rows of data to begin within a sheet?

How about

Sub Insertrws()
   Dim lr As Long, i As Long
   lr = Range("A" & Rows.Count).End(xlUp).row
   For i = (Int(lr / 10) * 10) + 1 To 11 Step -10
      Rows(i + 1).Resize(2).Insert
      Rows(i + 1).Resize(2).Clear
   Next i
End Sub

 

[Fluff]

How about

Sub Insertrws()
   Dim lr As Long, i As Long
   lr = Range("A" & Rows.Count).End(xlUp).row
   If lr < 15 Then Exit Sub
   For i = (Int(lr / 10) * 10) + 1 To 11 Step -10
      Rows(i + 1).Resize(2).Insert
      Rows(i + 1).Resize(2).Clear
   Next i
End Sub

 

[ameenuksg]

Hmm..didnt do anything new from the previous code

How about

Sub Insertrws()
   Dim lr As Long, i As Long
   lr = Range("A" & Rows.Count).End(xlUp).row
   If lr < 15 Then Exit Sub
   For i = (Int(lr / 10) * 10) + 1 To 11 Step -10
      Rows(i + 1).Resize(2).Insert
      Rows(i + 1).Resize(2).Clear
   Next i
End Sub