Excel Hints

Results 1 to 5 of 5

Thread: Solved: Speed up excel code

  1. #1

    Solved: Speed up excel code

    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.

    VB:
    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 
    
    
    Formatting tags added by mark007

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    24,068
    Location
    See if this is quicker

    VB:
    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 
    
    
    Formatting tags added by mark007
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    @ xld

    Thank you very much. Yours is much faster.

  4. #4
    or
    VB:
     
    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 
    
    
    Formatting tags added by mark007

  5. #5

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •