Lag in vba vlookup

Question

I'm running VBA code using vlookup, however, it take a few seconds to complete, despite the sheet that has the rows only has less than 150 rows.

The lag mainly appears during the generation of col 23.

The main sheet that contains this code has about 2300 rows.

Is the lag normal or is my coding inefficiency getting the best of me?

Private Sub Worksheet_Change(ByVal Target As Range)
    thisrow = Target.Row

    If Target.Column = 21 Then
        ' Generate the problem comments
        ' Declare some variables
        Dim CodeString As String
        Dim codeArr() As String
        Dim isPI As Boolean
        isPI = False

        ' Reset the impact, comment and origin cells
        Cells(thisrow, 22).Value = ""
        Cells(thisrow, 23).Value = ""
        Cells(thisrow, 25).Value = ""

        ' For esthetics, remove spaces in the cell
        Application.EnableEvents = False
        Cells(thisrow, 21).Value = Replace(Cells(thisrow, 21).Value, " ", "")
        Application.EnableEvents = True

        ' Get the code(s)
        CodeString = Cells(thisrow, 21).Value
        codeArr = Split(CodeString, Chr(59))

        ' Error code rows
        ErrLastRow = Sheets("lookup error codes").Cells(Sheets("lookup error codes").Rows.Count, 1).End(xlUp).Row

        ' There's more than one code
        If UBound(codeArr) > 0 Then
            For i = 0 To UBound(codeArr)
                If i < UBound(codeArr) Then
                    Cells(thisrow, 23).Value = Cells(thisrow, 23).Value & Application.WorksheetFunction.VLookup(CInt(codeArr(i)), Sheets("lookup error codes").Range("$A$2:$C$" & ErrLastRow).Value, 2, False) & "; "
                Else
                    Cells(thisrow, 23).Value = Cells(thisrow, 23).Value & Application.WorksheetFunction.VLookup(CInt(codeArr(i)), Sheets("lookup error codes").Range("$A$2:$C$" & ErrLastRow).Value, 2, False)
                End If
            Next i

            ' Check to see if anything is pay impacting
            For Each code In codeArr
                If Application.WorksheetFunction.VLookup(CInt(code), Sheets("lookup error codes").Range("$A$2:$C$" & ErrLastRow).Value, 3, False) <> "" Then
                    isPI = True

                    ' We only needed one
                    Exit For
                End If
            Next code
        Else
            ' There's only one code
            Cells(thisrow, 23).Value = Application.WorksheetFunction.VLookup(Cells(thisrow, 21).Value, Sheets("lookup error codes").Range("$A$2:$C$" & ErrLastRow).Value, 2, False)

            If Application.WorksheetFunction.VLookup(Cells(thisrow, 21).Value, Sheets("lookup error codes").Range("$A$2:$C$" & ErrLastRow).Value, 3, False) <> "" Then
                isPI = True
            End If
        End If

        ' There is a code that is pay impacting
        If isPI = True Then
            Cells(thisrow, 22).Value = "X"
        End If

        ' Modify the origin of error with common origins
        Dim Comment As Range, OrigErr As Range
        Set Comment = Range(Cells(thisrow, 23).Address)
        Set OrigErr = Range(Cells(thisrow, 25).Address)
        OrigErr.Value = ""
        If InStr(1, Comment.Value, "aaa", vbBinaryCompare) Or _
            InStr(1, Comment.Value, "bbb", vbBinaryCompare) Or _
            InStr(1, Comment.Value, "ccc", vbBinaryCompare) Then
                OrigErr.Value = "ddd"
        ElseIf InStr(1, Comment.Value, "eee", vbBinaryCompare) Then
            OrigErr.Value = "fff"
        End If
    End If
End Sub

Answer 1

Add

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

To the start of your code and

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

to the end.

Answer 2

Changing a cell's value to "" is triggering a change event. Disable events before changing anything on the worksheet and disable calculation if the changed cells affect other formulas.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Count > 1 Then Exit Sub

    If Target.Column = 21 Then
        ' Generate the problem comments

        ' Declare some variables
        Dim CodeString As String, codeArr As Variant
        Dim isPI As Boolean, thisRow As Long

        On Error GoTo safe_exit
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual

        thisRow = Target.Row
        isPI = False

        ' Reset the impact, comment and origin cells
        Cells(thisRow, 22) = vbNullString
        Cells(thisRow, 23).Value = vbNullString
        Cells(thisRow, 25).Value = vbNullString

        ' For esthetics, remove spaces in the cell
        Cells(thisRow, 21) = Replace(Cells(thisRow, 21).Value, " ", vbNullString)

        ' Get the code(s)
        CodeString = Cells(thisRow, 21).Value
        codeArr = Split(CodeString, Chr(59))

        ' Error code rows
        ErrLastRow = Sheets("lookup error codes").Cells(Sheets("lookup error codes").Rows.Count, 1).End(xlUp).Row

        ' Doesn't matter if there is one code or many
        For i = LBound(codeArr) To UBound(codeArr)
            If i < UBound(codeArr) Then
                Cells(thisRow, 23).Value = Cells(thisRow, 23).Value & Application.VLookup(CLng(codeArr(i)), Sheets("lookup error codes").Range("A:C"), 2, False) & "; "
            Else
                Cells(thisRow, 23).Value = Cells(thisRow, 23).Value & Application.VLookup(CLng(codeArr(i)), Sheets("lookup error codes").Range("A:C"), 2, False)
            End If
        Next i

        ' Check to see if anything is pay impacting
        For Each code In codeArr
            If Application.VLookup(CLng(code), Sheets("lookup error codes").Range("A:C"), 3, False) <> "" Then
                ' There is a code that is pay impacting
                Cells(thisRow, 22).Value = "X"
                ' We only needed one
                Exit For
            End If
        Next code

        If isPI Then
        End If

        ' Modify the origin of error with common origins
        Dim Comment As Range, OrigErr As Range
        Set Comment = Cells(thisRow, 23)
        Set OrigErr = Cells(thisRow, 25)
        OrigErr.Value = vbNullString
        If InStr(1, Comment.Value, "aaa", vbBinaryCompare) Or _
           InStr(1, Comment.Value, "bbb", vbBinaryCompare) Or _
           InStr(1, Comment.Value, "ccc", vbBinaryCompare) Then
                OrigErr.Value = "ddd"
        ElseIf InStr(1, Comment.Value, "eee", vbBinaryCompare) Then
            OrigErr.Value = "fff"
        End If
    End If

safe_exit:
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub