VBA: Vlookups to auto-populate data into a list - can it be more efficient?

[blonde]

Hi,

I have created some code for doing some vlookups to auto-populate data into a spreadsheet list. Against each record, the user selects the correct value from a drop down list, then, based on the value chosen, the vlookups find the matching value from a different sheet (the ‘Hosts List’) and then populate cells in the record row with data from the vlookup table.

I am using vlookups in VBA rather than in the spreadsheet as I want the user to be able to make minor changes to the populated values if required, relevant to the unique record. The ‘show error alert’ is unticked in the data validation criteria for the drop down list to enable the user to input a one-off value not contained within the drop down list, and then manually enter the rest of the data.

The code works. However, there is a bit of a time lag on it when the user inputs a manual entry in the cell with the drop down list (the active cell). I was wondering whether the whole coding could be written more efficiently to speed it up, or (more preferably) is there a line of code I could use to exit the sub should the user input a manual entry in the active cell and so a vlookup is not required?

Here is the code:

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim HostName As String
Dim FindHostAddr1 As String
Dim FindHostAddr2 As String
Dim FindHostAddr3 As String
Dim HostCity As String
Dim HostZip As String
Dim HostCountry As String
Dim HostCtName As String
Dim HostCtEmail As String
Dim HostCtTel As String
 
If Intersect(Target, Range("L7:L901")) Is Nothing Then
    Exit Sub
Else
   
On Error Resume Next
   
  HostName = ActiveCell.Value
   
    FindHostAddr1 = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 2, False)
    FindHostAddr2 = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 3, False)
    FindHostAddr3 = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 4, False)
    HostCity = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 5, False)
    HostZip = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 6, False)
    HostCountry = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 7, False)
    HostCtName = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 8, False)
    HostCtEmail = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 9, False)
    HostCtTel = Application.WorksheetFunction.VLookup(HostName, Sheets("Hosts List").Range("A2:K250"), 10, False)
   
    ActiveCell.Offset(0, 1).Value = FindHostAddr1
    ActiveCell.Offset(0, 2).Value = FindHostAddr2
    ActiveCell.Offset(0, 3).Value = FindHostAddr3
    ActiveCell.Offset(0, 4).Value = HostCity
    ActiveCell.Offset(0, 5).Value = HostZip
    ActiveCell.Offset(0, 6).Value = HostCountry
    ActiveCell.Offset(0, 9).Value = HostCtName
    ActiveCell.Offset(0, 10).Value = HostCtEmail
    ActiveCell.Offset(0, 11).Value = HostCtTel
 
 
End If
 
End Sub

 

[Fluff]

Untested, but try

Private Sub Worksheet_Change(ByVal Target As Range)
   
   Dim Fnd As Range

   If Target.CountLarge > 1 Then Exit Sub
   If Intersect(Target, Range("L7:L901")) Is Nothing Then Exit Sub
Application.EnableEvents = False
   Set Fnd = Sheets("Hosts List").Range("A2:A250").Find(Target.Value, , , xlWhole, , , False, , False)
   If Not Fnd Is Nothing Then
      Target.Offset(, 1).Resize(, 6).Value = Fnd.Offset(, 1).Resize(, 6).Value
      Target.Offset(, 9).Resize(, 3).Value = Fnd.Offset(, 7).Resize(, 3).Value
   End If
Application.EnableEvents = True
End Sub

 

[blonde]

Thank you very much for your help on this. It works and is much faster! It comes across more professional now.
Cheers.

 

[Fluff]

Glad to help & thanks for the feedback