VBA Delete lines based on cells values - excel

Question

I have a monthly report with 25K-30K lines from which I want to delete lines based on cell values. The report has a dynamic number of rows each month but the number of columns are fixed, from A to X. I am using the For Next Loop to search into the cells for the values that will trigger the deletion of rows, in the worksheet "Data" of the report. There is a second sheet in this report named "Public accounts" where the macro searches and adds a tag (public or private) into each of the rows in the "Data" sheet. It then checks several conditions (like if the values of the cells in columns R and S are equal then the line is deleted) using the For Next loop and if they are true the lines are deleted in the "Data" sheet of the report.
My problem is that it takes far too long to run (10-15 mins) in its condition. Can you please help me to speed it up? I am attaching the code that I am using.
Sub Format_Report()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Worksheets("Data").Activate
LR = Range("A" & Rows.Count).End(xlUp).Row
Range("X2").Formula = "=if(isnumber(Match(A2,'Public accounts'!A:A,0)),""Public"",""Private"")"
Range("X2").AutoFill Destination:=Range("X2:X" & LR)
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "R").Value) = (Cells(i, "S").Value) Then
Cells(i, "A").EntireRow.Delete
End If
Next i
For i = Last To 1 Step -1
If (Cells(i, "G").Value) = "ZRT" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
For i = Last To 1 Step -1
If (Cells(i, "G").Value) = "ZAF" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
For i = Last To 1 Step -1
If (Cells(i, "G").Value) = "E" Then
Cells(i, "A").EntireRow.Delete
End If
Next i
For i = Last To 1 Step -1
If Cells(i, 24) = "Public" Then
Cells(i, 24).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Answer 1

Please, test the next code. It should work very fast, using arrays, sort, delete at once, resort and clear the helper sort column:
Sub Format_Report()
Dim wsD As Worksheet, lastRD As Long, lastCol As Long
Dim arr, arrMark, arrSort, i As Long, boolFound As Boolean
Set wsD = ActiveSheet 'Worksheets("Data")
lastRD = wsD.Range("A" & wsD.rows.count).End(xlUp).row
lastCol = wsD.UsedRange.column + wsD.UsedRange.Columns.count + 1
arrSort = Evaluate("row(1:" & lastRD & ")") 'build an array to resort after deletion
wsD.Range("X2:X" & lastRD).Formula = "=if(isnumber(Match(A2,'Public accounts'!A:A,0)),""Public"",""Private"")"
wsD.Calculate
arr = wsD.Range("G1:X" & lastRD).Value2 'place the range in an array for faster iteration
ReDim arrMark(1 To UBound(arr), 1 To 1) 'reDim the array to keep deletion marks
For i = 1 To lastRD
If arr(i, 12) = arr(i, 13) And (arr(i, 12) <> "") Or _
arr(i, 1) = "ZRT" Or _
arr(i, 1) = "ZAF" Or _
arr(i, 1) = "E" Or _
arr(i, 18) = "Public" Then
arrMark(i, 1) = "Del": boolFound = True 'write in array an boolFound = true to confirm at least a row to be deleted
End If
Next i
Application.ScreenUpdating = False: Application.DisplayAlerts = False
wsD.cells(1, lastCol).Resize(UBound(arrMark), 1).Value2 = arrMark 'drop arrMark content at once:
wsD.cells(1, lastCol + 1).Resize(UBound(arrSort), 1).Value2 = arrSort
'sort the range based on arr column:
wsD.Range("A1", wsD.cells(lastRD, lastCol + 1)).Sort key1:=wsD.cells(1, lastCol), Order1:=xlAscending, Header:=xlNo ' sort the range by deletion column
With wsD.cells(1, lastCol).Resize(lastRD, 1)
If boolFound Then 'if at least a row to be deleted:
.SpecialCells(xlCellTypeConstants).EntireRow.Delete
End If
End With
'Resort the range based on arrSort column:
wsD.Range("A1", wsD.cells(lastRD, lastCol + 1)).Sort key1:=wsD.cells(1, lastCol), Order1:=xlAscending, Header:=xlNo
wsD.cells(lastRD, lastCol + 1).EntireColumn.ClearContents 'clear the column with the initial order
Application.ScreenUpdating = True: Application.DisplayAlerts = True
MsgBox "Ready..."
End Sub