Consulting

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.

    [VBA]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]

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    See if this is quicker

    [vba]
    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]
    ____________________________________________
    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
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    or
    [vba]
    sub snb()
    with application
    .screenupdating=false
    .calculation= xlcalculationmanual

    for j=1 to 6
    columns(1).replace choose(j,"*#*","END*","*BeGIN*","*TITLE*","*SCANS*","*RTINSECONDS*","*_DIST ILLER_*"),"",xlpart
    next
    columns(1).specialcells(4).entirerow.delete

    .calculation=xlcalculationautomatic
    .screenupdating=true
    end with
    end sub
    [/vba]

  5. #5
    @ snb

    Thank you very much.

Posting Permissions

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