Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngFindRange As Range
If Intersect(Target, Range("A2:A" & Rows.Count)) Is Nothing Then Exit Sub
If Intersect(Target, Range("A2:A" & Rows.Count)).Count > 1 Then
MsgBox "One entry only in column A please."
Application.Undo
End If
Set rngFindRange = Sheets("Sheet2").Range("A2:A" & Rows.Count).Find(Target.Value, _
LookIn:=xlValues, lookat:=xlWhole)
If Not rngFindRange Is Nothing Then
Application.EnableEvents = False
Target.Offset(0, 1) = rngFindRange.Offset(0, 1)
Target.Offset(0, 2) = rngFindRange.Offset(0, 2)
Application.EnableEvents = True
Else
MsgBox "No match for ID Number."
End If
End Sub