Option Explicit
Dim Change As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i&
ListBox1.Visible = False
If Target.Count <> 1 Then Exit Sub
If Intersect(Target, Range("c2:c" & Rows.Count)) Is Nothing Then Exit Sub
ListBox1.ListFillRange = "a1:a6"
ListBox1.Top = Target.Top + Target.Height + 2
ListBox1.Left = Target.Left + Target.Width / 3
On Error GoTo ERR001
Change = False
For i = 0 To ListBox1.ListCount - 1
If InStr(Target, ListBox1.List(i)) > 0 Then ListBox1.Selected(i) = True
Next i
ListBox1.Visible = True
ERR001:
Change = True
End Sub
Private Sub ListBox1_Change()
Dim i&, s As String
If Not Change Then Exit Sub
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
s = s & " " & ListBox1.List(i)
End If
Next i
ActiveCell = Application.Trim(s)
End Sub