Code needs to be run twice

[Jammydan]

Hi, I have the following code that deletes rows if certain conditions are met then inserts a new row.

However, it has to be run at least twice for it to delete all rows, can anybody see why?

Sub DeleteRowDG()
Dim Cell As Range
Dim DeleteDG As Range
Set DeleteDG = Range("G5:G60")
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="123"
    Rows("4").EntireRow.Hidden = False
    For Each Cell In DeleteDG
        If Cell.Value > 1 And Cell.Offset(0, 2) = "" Then
        ActiveSheet.Unprotect Password:="123"
            Cell.EntireRow.Select
            Selection.Delete Shift:=xlUp
            Range("E3").End(xlDown).Offset(1, 0).Select
            Application.Run "InsertRowsAndFillFormulas_caller"
        End If
    Next Cell
    Application.ScreenUpdating = True
End Sub
Sub InsertRowsAndFillFormulas_caller()
  Call InsertRowsAndFillFormulas
End Sub
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)
ActiveSheet.Unprotect Password:="123"
   ' row selection based on active cell
   Dim x As Long
   Dim ODWarning As Range
   Set ODWarning = Range("B65:T66")
   Application.EnableEvents = False
      ActiveCell.EntireRow.Select  'So you do not have to preselect entire row
   If vRows = 0 Then
    vRows = 1
    If vRows = False Then Exit Sub
    End If
   Dim sht As Worksheet, shts() As String, i As Integer
   ReDim shts(1 To Worksheets.Application.ActiveWorkbook. _
       Windows(1).SelectedSheets.Count)
   i = 0
   For Each sht In _
       Application.ActiveWorkbook.Windows(1).SelectedSheets
    Sheets(sht.Name).Select
    i = i + 1
    shts(i) = sht.Name
    x = Sheets(sht.Name).UsedRange.Rows.Count 'lastcell fixup
    Selection.Resize(rowsize:=2).Rows(2).EntireRow. _
     Resize(rowsize:=vRows).Insert Shift:=xlDown
    Selection.AutoFill Selection.Resize( _
     rowsize:=vRows + 1), xlFillDefault
    On Error Resume Next    'to handle no constants in range
    ' to remove the non-formulas
    Selection.Offset(1).Resize(vRows).EntireRow. _
     SpecialCells(xlConstants).ClearContents
   Next sht
   Worksheets(shts).Select
   Application.CalculateFull
 
   Range("E3").End(xlDown).Offset(1, 0).Select
   Rows("4").EntireRow.Hidden = True
   Application.EnableEvents = True
 
    If Range("L65") = Range("N65") Then
        ODWarning.Interior.ColorIndex = 2
    ElseIf Range("L65") <> Range("N65") Then
        ODWarning.Interior.ColorIndex = 3
    End If
    Range("B67:T67").Interior.ColorIndex = 0
 
    ActiveSheet.Protect Password:="123"
 
End Sub

 

[VoG]

You need to loop backwards when deleting rows. Try like this

Set DeleteDG = Range("G5:G60")
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="123"
    Rows("4").EntireRow.Hidden = False
    For i = 60 To 5 Step -1
        If Range("G" & i).Value > 1 And Range("G" & i).Offset(0, 2).Value = "" Then
            ActiveSheet.Unprotect Password:="123"
            Rows(i).Delete
            Range("E3").End(xlDown).Offset(1, 0).Select
            Application.Run "InsertRowsAndFillFormulas_caller"
        End If
    Next i

 

[Jammydan]

Thanks Peter, that's great!