Inserting new row after every nth row - problem

[EdwardL95]

Hi all new to VBA,

Task: Insert a new row every 12th row starting at cell A14 with the text "NEG".

Problem: After running the macro it will miss the last NEG in the last set of data. Possibly due to the last row changing after the macro adds in new rows and pushing the data down?

Is there a way to work around this?

Code below I've been using found on this website.

Option Explicit

Sub Evry12()
Dim i As Long
Dim lr As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = 14 To lr
Range("A" & i).EntireRow.Insert
Range("A" & i) = "NEG"
i = i + 11
Next i
End Sub

Thanks,
Ed

 

[Marc L]

Is there a way to work around this?

Hi, just following the Logic :​

Sub Demo1()
    Dim R&
        R = 14
        Application.ScreenUpdating = False
    While Not IsEmpty(Cells(R, 1))
        Rows(R).Insert
        Cells(R, 1).Value2 = "NEG"
        R = R + 11
    Wend
        Application.ScreenUpdating = True
End Sub

 

[EdwardL95]

Hi, just following the Logic :​

Sub Demo1()
    Dim R&
        R = 14
        Application.ScreenUpdating = False
    While Not IsEmpty(Cells(R, 1))
        Rows(R).Insert
        Cells(R, 1).Value2 = "NEG"
        R = R + 11
    Wend
        Application.ScreenUpdating = True
End Sub

Thanks Marc.

 

[Marc L]

My previous demonstration revamped for non smart worksheet as well :​

Sub Demo1r()
    Dim R&, Rg As Range
        R = 14
        Set Rg = Cells(Rows.Count, 1).End(xlUp)
        Application.ScreenUpdating = False
    While R <= Rg.Row
        Rows(R).Insert
        Cells(R, 1).Value2 = "NEG"
        R = R + 11
    Wend
        Application.ScreenUpdating = True
        Set Rg = Nothing
End Sub

 

[Peter_SSs]

Welcome to the MrExcel board!

Another option would be to do them all at once.

Sub Insert_Every_10_Rows()
  Application.ScreenUpdating = False
  With Cells(14, Cells.Find("*", , xlFormulas, , , xlByColumns, xlPrevious).Column + 1).Resize(Range("A" & Rows.Count).End(xlUp).Row - 13)
    .Value = Evaluate("if(right(row(" & .Address & "),1)=""" & Right(.Cells(1).Address, 1) & """,1,"""")")
    .SpecialCells(2, 1).EntireRow.Insert
    Intersect(.SpecialCells(2, 1).EntireRow, Columns("A")).Offset(-1).Value = "NEG"
    .ClearContents
  End With
  Application.ScreenUpdating = True
End Sub