Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$D$4" Then Exit Sub
Application.EnableEvents = False
Target.Select
Target = Replace(Target, Chr(130), ",")
Application.EnableEvents = True
If Application.CountIf([B:B], Target) Then Exit Sub
Dim cel As Range, txt$
For Each cel In Range("B2", [B65536].End(xlUp))
If LCase(cel) Like "*" & LCase(Target) & "*" Then
txt = txt & IIf(txt = "", "", ",") & Replace(cel, ",", Chr(130))
End If
Next
With Target.Validation
.Delete
If Target = "" Or txt = "" Then Exit Sub
.Add xlValidateList, Formula1:=txt
.ShowError = False
End With
Application.SendKeys "%{UP}"
End Sub