Delete specifics rows in a sheet with more than 60000 rows - excel

Question

I need to delete the rows that:
- Does not have the Word "Get" into Column A, example: if A1 is Configuration Get, I should not delete; but if it is nFormat or anything else, I should delete.
- And for the rows which has the word "get" I also need to check if in Column C the value is 0, if it is not 0 I also should delete.
My function is working for sheet with a small number of rows, but the problem is, I really need to run it for a large number, let's say for 60000 rows. Could someone help me?
My function is:
Sub DeleteRows()
Dim c As Range
Dim ColumnA
Dim Lrow As Long
Dim Lastrow As Long
With Sheets("Sheet1") 'I'm using the Sheet1
.Select
Set ColumnA = ActiveSheet.UsedRange
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
For Lrow = Lastrow To 1 Step -1
Set ColumnA = Cells(Lrow, "A") 'I'm looking just in Column "A" for a Get
Set c = ColumnA.Find("Get", LookIn:=xlValues)
If Not c Is Nothing Then
' If the cell has a Get, it will look for a 0 in Column "C"
With .Cells(Lrow, "C")
If Not IsError(.Value) Then
' If the Value is not 0 the row will be delete.
If Not (.Value = 0) Then .EntireRow.Delete
End If
End With
Else
'If didn't find a "Get", it will delete the row
ColumnA.EntireRow.Delete
End If
Next Lrow
End With
End Sub

Answer 1

Try something like this which uses AutoFilter instead
It is the VBA equivalent of:
finding the first blank column
entering =OR(ISERROR(FIND("Get",$A1)),AND(NOT(ISERROR(FIND("Get",$A1))),$C1<>0)) in row 1 and copying down
deleting and TRUE results
cleaning up the working column
code
Sub KillEm()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Set rng1 = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious)
Set rng2 = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
Set rng3 = Range(Cells(rng2.Row, rng1.Column), Cells(1, rng1.Column))
Application.ScreenUpdating = False
With rng3.Offset(0, 1)
.FormulaR1C1 = "=OR(ISERROR(FIND(""Get"",RC1)),AND(NOT(ISERROR(FIND(""Get"",RC1))),RC3<>0))"
.AutoFilter Field:=1, Criteria1:="TRUE"
.Offset(1, 0).Resize(rng3.Rows.Count - 1, 1).EntireRow.Delete
.EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub

Answer 2

I did like this for, in this case sheet7, and it worked:
Application.ScreenUpdating = False
With Sheet7
r = 1
Do While r <= LastRow
If IsError(.Cells(r, 1)) Then
.Rows(r).Delete
LastRow = LastRow - 1
Else
If InStr(.Cells(r, 1), "Get") = 0 Then
.Rows(r).Delete
LastRow = LastRow - 1
Else
r = r + 1
End If
End If
Loop
End With
Application.ScreenUpdating = True