If 0 or "" delete row: code works but very slow

Question

Question:

With the recorder and help on this forum I made a code (for a button). Column 'i' has got (from row 25) 'Pcs' or a number. My Macro finds Pcs and changes it to "" and than the macro deletes "" and 0's. lenght of the filled cells is variable, so I made 500 as 'end' but it never reaches that. If I run the macro, it works and does the job, but takes very long, especially because it has to do 500 lines..

Sub Fix()

Dim intEnd As Integer
Range("M1").Select
Cells.Replace What:="pcs", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
intEnd = 500

Range("I25").Select

Do Until ActiveCell.Row = intEnd

If Int(ActiveCell.Value) = 0 Then
Range(ActiveCell.Row & ":" & ActiveCell.Row).Delete
intEnd = intEnd - 1
Else
ActiveCell.Offset(1, 0).Select
End If

Loop
End sub

I was happy that I could make this macro with help of the forum and the recorder, but now I am stuck speeding it up, no real clue where to start. Does anybody has a tip?

Thanks, if more info or effort needed, please let me know.

Answer 1

To do it in a fast use able way, you can use this:

Sub DelMe()
  Dim i As Long, x As Variant, y As Range
  With Sheets("Sheet1")
    x = .Range("I1", .Cells(Rows.Count, 9).End(xlUp)).Value
    If UBound(x) < 25 Then Exit Sub
    For i = 25 To UBound(x)
      If x(i, 1) = 0 Or x(i, 1) = "" Or InStr(1, x(i, 1), "pcs", vbTextCompare) > 0 Then
        If y Is Nothing Then
          Set y = .Rows(i)
        Else
          Set y = Union(y, .Rows(i))
        End If
      End If
    Next
    y.EntireRow.Delete xlUp
  End With
End Sub

It simply deletes all ranges (which you want to be deleted) at once.

If you have any questions, just ask :)

Answer 2

Try this:

Sub fix3()


Dim intEnd As Long
Dim ws As Worksheet
Dim i As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error GoTo getout
Set ws = Sheets("Sheet1") 'Change to your sheet
ws.Cells.Replace What:="pcs", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

intEnd = ws.Range("I" & ws.Rows.Count).End(xlUp).row

For i = intEnd To 25
    If Int(ws.Cells(i, "I").Value) = 0 Then
        ws.Rows(i).Delete
    End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub

getout:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub