Speeding up VBA Vlookup on Worksheet Change

[JumboCactuar]

Hi,
i have the following which on worksheet change, looks up the value in column A and outputs the matching data from Data Sheet

it uses the FIND vba function but im unsure if theres a better way to do this as it can lag on fast input:

Private Sub Worksheet_Change(ByVal Target As Range)


Dim Item As String
Dim Item_Found As Range


If Left(Target.Address, 3) = "$A$" Then
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target = "" Then Exit Sub


'Avoid the endless loop:
Application.EnableEvents = False


Item = Target.Value


'Lookup - OrderID
    With Sheets("Data")
        Set Item_Found = .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 Item_Found Is Nothing Then
                Target.Offset(0, 1).Value = Item_Found.Offset(0, 1).Value
                Target.Offset(0, 2).Value = Item_Found.Offset(0, 7).Value
                Target.Offset(0, 3).Value = Item_Found.Offset(0, 8).Value
                Target.Offset(0, 4).Value = Item_Found.Offset(0, 9).Value
                Target.Offset(0, 5).Value = Item_Found.Offset(0, 10).Value
                Target.Offset(0, 6).Value = Item_Found.Offset(0, 11).Value
                Target.Offset(0, 7).Value = Item_Found.Offset(0, 12).Value
                Target.Offset(0, 8).Value = Item_Found.Offset(0, 13).Value
            Else
              
            End If
    End With
   
End If


'Enable the Events again:
Application.EnableEvents = True




End Sub

any recommended changes ?

 

[Fluff]

Why not replace the macro with an index/match formula?

 

[JumboCactuar]

Why not replace the macro with an index/match formula?

The resulting data is editable and then i use the same method to update the record in data sheet so the formulas would be overwritten.

 

[Fluff]

Ok, probably no quicker, but you could use

Private Sub Worksheet_Change(ByVal Target As Range)


Dim Item As String
Dim Item_Found As Range


If Left(Target.Address, 3) = "$A$" Then
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target = "" Then Exit Sub


'Avoid the endless loop:
Application.EnableEvents = False


Item = Target.Value


'Lookup - OrderID
    With Sheets("pcode")
        Set Item_Found = .Columns(1).Find(What:=Item, After:=.Cells(1, 1) _
                , LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows _
                , SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
    
    
            If Not Item_Found Is Nothing Then
                Target.Offset(0, 1).Value = Item_Found.Offset(0, 1).Value
                Target.Offset(0, 2).Resize(, 7).Value = Item_Found.Offset(0, 7).Resize(, 7).Value
            End If
    End With
   
End If


'Enable the Events again:
Application.EnableEvents = True




End Sub

 

[JumboCactuar]

thanks i will try this

i added disable screenupdating also that seems to speed it up