Need VBA code to run faster

Question

I've just started doing coding in Excel and this is what I have:

Public strKeyword

Sub DataSearch()
    Dim strKeyword As String

    strKeyword = ActiveSheet.Range("B4").Value

    strKeyword = "*" & strKeyword & "*"

    Application.ScreenUpdating = False

    Worksheets("List_of_Incidents").Visible = True
    Worksheets("List_of_Incidents").Select

    ActiveSheet.Range("$B$1:$B$500").AutoFilter Field:=1
    Range("B1").Select

    With ActiveSheet
        .AutoFilterMode = False
        With Range("B1", Range("B" & Rows.Count).End(xlUp))
            .AutoFilter 1, strKeyword, xlAnd

        End With

        AutoFilterMode = False

    End With

    CopyVisibleCells

End Sub

Sub CopyVisibleCells()

    Range("B1:D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    Sheets("Search").Select

    Range("A9:C9").Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                                                                         , SkipBlanks:=False, Transpose:=False

    Columns("A:A").EntireColumn.AutoFit
    Rows("8:8").EntireRow.AutoFit

    Range("A8").Select
    Application.CutCopyMode = False

    If Range("A10") = "" Then ErrCapture

    Range("B4:B5").Select

    Worksheets("List_of_Incidents").Visible = False

End Sub

Sub ErrCapture()

    MsgBox ("Invalid Search! Please click New Search and Try Again")

    Exit Sub

End Sub

The problem is: When I get an error, it takes forever for the error message to pop up then it crashes Excel (not responding) is anyone able to help me fix this.

Take a look at [how to avoid using Select](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) — gizlmo, Jul 20 '16 at 05:24
Also in a line of code u are missing the . for autofiltermode — Steven Martin, Jul 20 '16 at 06:11

score 1 · Answer 1 · answered Jul 20 '16 at 06:23

I refactored your code and removed any unnecessary operations.

Sub DataSearch()
    Dim rFilteredData As Range
    Dim strKeyword As String

    strKeyword = "*" & Range("B4").Value & "*"

    Application.ScreenUpdating = False

    With Worksheets("List_of_Incidents")
        .AutoFilterMode = False

        .Range("B1", .Range("B" & Rows.Count).End(xlUp)).AutoFilter 1, strKeyword, xlAnd

        Set rFilteredData = Intersect(.Range("B:D"), .UsedRange)

        rFilteredData.Copy

        Sheets("Search").Range("A9").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
                                                                                                , SkipBlanks:=False, Transpose:=False
        AutoFilterMode = False

    End With

    Application.ScreenUpdating = True
End Sub

Hi Thomas, I tried out your code but it no longer brings up the error message. — Danette, Jul 20 '16 at 06:35

score 1 · Answer 2 · answered Jul 20 '16 at 07:21

1

it crashes Excel (not responding) is anyone able to help me fix this.

Application.ScreenUpdating = False

Yes, you have to turn ScreenUpdating back on again.

answered Jul 20 '16 at 07:21

david

2,435
1
21
33

Hi, this does not work. And completely freezes Excel. – Danette Jul 20 '16 at 23:14

Need VBA code to run faster

2 Answers2