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.

Answer 1

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

Answer 2

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.