Worksheet_Change lookup - any better way?

[JumboCactuar]

Hi,
I have the following which basically works like a vlookup
(When data is entered / scanned into column A ,
B,C,D is filled from another sheet

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Item        As String
    Dim LookupResult      As Range
    
    If Target.Cells.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub
    
    If Left(Target.Address, 3) = "$A$" Then
        
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        
        Item = Target.Value
        
            With Sheets("Data")
                Set LookupResult = .Columns(1).Find(What:=Item, After:=.Cells(1, 1) _
                    , LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows _
                    , SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
                
                On Error GoTo 0
                
                If Not LookupResult Is Nothing Then

                    Target.Offset(0, 1).Value = LookupResult.Offset(0, 1).Value

                    Target.Offset(0, 2).Value = LookupResult.Offset(0, 2).Value

                    Target.Offset(0, 3).Value = LookupResult.Offset(0, 3).Value

                    Target.Offset(0, 4).Value = LookupResult.Offset(0, 4).Value
                Else
 
                End If
            End With

        Application.EnableEvents = True
        Application.ScreenUpdating = True
        
    Else

        
    End If
    
End Sub

Though when scanned fast, there is noticeable lag between each cell.

Is there any better ways to do this? Maybe store the lookup data in array so worksheet is not referenced

Thanks for any help

 

[JackDanIce]

This may be quicker, replace all of your code and try:

Private Sub Worksheet_Change(ByVal Target As Range)
   
    With Target
        If .CountLarge > 1 Then Exit Sub
        If .Column = 1 And Len(.Value) > 0 Then Update_From_Data Target, Sheets("Data")
    End With
   
End Sub

Private Sub Update_From_Data(ByRef Target As Range, ByRef Data As Worksheet)
   
    Dim LR  As Long: LR = Data.Cells(Rows.Count, 1).End(xlUp).Row
    Dim a   As Long
   
    With Target
        On Error Resume Next
        a = Data.Cells(1, 1).Resize(LR).Find(Target.Value).Row
        On Error GoTo 0
        If a = 0 Then Exit Sub
        Application.EnableEvents = False
        .Offset(, 1).Resize(, 4).Value = Data.Cells(a, 2).Resize(, 4).Value
        Application.EnableEvents = True
    End With
   
End Sub

 

[Norie]

Perhaps setting calculation to Manual might help.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Item As String
Dim Res As Variant

    If Target.Cells.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub

    If Target.Column = 1 Then

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

        Item = Target.Value

        With Sheets("Data")
            Res = Application.Match(Item, .Columns(1), 0)

            If Not IsError(Res) Then
                Target.Offset(, 1).Resize(4).Value = .Range("B" & Res).Resize(, 4).Value
            End If
        End With

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

    End If

End Sub