Lag in vba vlookup - vba

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

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

Answer 2

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.