Dim arr(), i&
With Worksheets("Egger")
       arr = .Range(.Cells(3, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Value
End With
With Worksheets(1).ListBox1
.Clear
.List = arr
       For i = .ListCount - 1 To 0 Step -1
           If Not (LCase(.List(i)) Like LCase(TextBox1 & "*")) Then
           .RemoveItem (i)
           End If
       Next
           .Top = ActiveCell.Top + ActiveCell.Height
           .Left = ActiveCell.Left
           .Height = 100
           .Width = ActiveCell.Width
           .Visible = 1

End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(ActiveCell, Range("D3")) Is Nothing Then
       With Me.TextBox1
           .Top = ActiveCell.Top
           .Left = ActiveCell.Left
           .Height = ActiveCell.Height
           .Width = ActiveCell.Width
           .Text = ""
           .Visible = 1
           .Activate
       End With
       Else
       TextBox1.Visible = 0
       ListBox1.Visible = 0
End If
End Sub