Solved: Speed up excel code

[copyt]

Hello all, I have a code (recorded macro) to search and delete rows containing certain texts. Since the data is in rangeA1:A30000 so it takes a long time to finish. Any idea to speed it up? Any help/suggestion would be appreciated.

Sub import_MGF_distiller_part01() 
    Application.ScreenUpdating = False 
     
     
     
    Columns("A:A").Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$1:$A$5").AutoFilter Field:=1, Criteria1:="=*#*", _ 
    Operator:=xlOr, Criteria2:="=*END*", Operator:=xlAnd 
    Selection.EntireRow.Delete Shift:=xlUp 
     
    Application.ScreenUpdating = False 
     
    Columns("A:A").Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$1:$A$5").AutoFilter Field:=1, Criteria1:="=*BEGIN*", _ 
    Operator:=xlOr, Criteria2:="=*TITLE*", Operator:=xlAnd 
    Selection.EntireRow.Delete Shift:=xlUp 
     
    Application.ScreenUpdating = False 
     
    Columns("A:A").Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$1:$A$5").AutoFilter Field:=1, Criteria1:="=*SCANS*", _ 
    Operator:=xlOr, Criteria2:="=*RAWSCANS*", Operator:=xlAnd 
    Selection.EntireRow.Delete Shift:=xlUp 
     
    Application.ScreenUpdating = False 
     
    Columns("A:A").Select 
    Selection.AutoFilter 
    ActiveSheet.Range("$A$1:$A$5").AutoFilter Field:=1, Criteria1:="=*RTINSECONDS*", _ 
    Operator:=xlOr, Criteria2:="=*_DISTILLER_*", Operator:=xlAnd 
    Selection.EntireRow.Delete Shift:=xlUp 
     
End Sub 

VBA tags courtesy of www.thecodenet.com

[xld]

See if this is quicker

Sub import_MGF_distiller_part01() 
    Dim rng As Range 
    Dim lastrow As Long 
     
    Application.ScreenUpdating = False 
     
    With ActiveSheet 
         
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row 
        .Columns("B").Insert 
        .Range("B1").Value = "tmp" 
        .Range("B2").Resize(lastrow - 1).Formula = "=OR(ISNUMBER(SEARCH(""#"",A2)),ISNUMBER(SEARCH(""END"",A2))," & _ 
        "ISNUMBER(SEARCH(""BEGIN"",A2)),ISNUMBER(SEARCH(""TITLE"",A2))," & _ 
        "ISNUMBER(SEARCH(""SCANS"",A2)),ISNUMBER(SEARCH(""ROWSCANS"",A2))," & _ 
        "ISNUMBER(SEARCH(""RTINSECONDS"",A2)),ISNUMBER(SEARCH(""_DISTILLER_"",A2)))" 
        Set rng = .Range("B1").Resize(lastrow) 
        rng.AutoFilter 
        rng.AutoFilter Field:=1, Criteria1:="=TRUE" 
        On Error Resume Next 
        Set rng = rng.Offset(1, 0).SpecialCells(xlCellTypeVisible) 
        On Error Goto 0 
        If Not rng Is Nothing Then 
             
            rng.EntireRow.Delete 
        End If 
         
        .Columns("B").Delete 
    End With 
     
    Application.ScreenUpdating = True 
End Sub 

VBA tags courtesy of www.thecodenet.com

[copyt]

@ xld

Thank you very much. Yours is much faster.

[snb]

or

 
Sub snb() 
    With application 
        .screenupdating=False 
        .calculation= xlcalculationmanual 
         
        For j=1 To 6 
            columns(1).replace choose(j,"*#*","END*","*BeGIN*","*TITLE*","*SCANS*","*RTINSECONDS*","*_DISTILLER_*"),"",xlpart 
        Next 
        columns(1).specialcells(4).entirerow.delete 
         
        .calculation=xlcalculationautomatic 
        .screenupdating=True 
    End With 
End Sub 

VBA tags courtesy of www.thecodenet.com

[copyt]

@ snb

Thank you very much.