Private Sub Worksheet_Change(ByVal Target As Range) 
     'Sub "autocompletes" data entered into column A using a source table on a different worksheet. If more than one match is
     '    found, the user is allowed to continue entering characters until a unique match is found. If no matches are found, the
     '    data is accepted as entered. ALT + Enter, Enter to force the macro to accept data as entered. The sub is triggered by
     '    the Enter key.
    Dim cel As Range, match1 As Range, match2 As Range, rg As Range, targ As Range 
     
     '***Please adjust the next two statements before using this code!***
    Set targ = Intersect(Target, Range("A:A")) 'Watch the cells in column A
    Set rg = Worksheets("Source data").Range("AutoCompleteText") 'Use named range AutoCompleteText for "autocomplete" info
     
    If targ Is Nothing Then Exit Sub 
    Application.ScreenUpdating = False 
    Application.EnableEvents = False 
    On Error GoTo errhandler 'If code encounters an error, turn events back on
     
    For Each cel In targ 
        If Not IsError(cel) Then 
            If cel <> "" And Right(cel, 1) <> Chr(10) Then 
                Set match1 = Nothing 
                Set match1 = rg.Find(cel & "*", lookat:=xlWhole, MatchCase:=False) 'Match is case insensitive
                If Not match1 Is Nothing Then 
                    Set match2 = rg.FindNext(after:=match1) 
                    If match2.Address = match1.Address Then 'Code is fooled by identical strings in two cells
                        cel = match1 'Only one match found. Use it to "autocomplete" the cell
                    Else 'More than one match found. User must enter more data. Return to "Edit" mode
                        cel.Activate 
                        Application.SendKeys ("{F2}") 'Begin editing after last character entered
                    End If 
                Else 'No matches found. Do not change entered text
                End If 
            Else 'Strip the line feed from the end of the text string
                If cel <> "" And Right(cel, 1) = Chr(10) Then cel = Left(cel, Len(cel) - 1) 
            End If 
        End If 
    Next cel 
     
    errhandler: Application.EnableEvents = True 
    On Error GoTo 0 
    Application.ScreenUpdating = True 
End Sub