Private Sub TextBox1_Change()
Dim j As Long, i As Long, TT, ttt

ListBox1.Clear
TT = TextBox1
'при отсутствии символов для поиска - выход
   If Len(TextBox1.Value) = 0 Then Exit Sub
   j = 0
For ttt = 2 To 5 ' столбцы B:E
'для одного символа поиск осуществляем по первой букве
If Len(TextBox1.Value) = 1 Then
    For i = 2 To Cells(Rows.Count, ttt).End(xlUp).Row
        If UCase(Left(Cells(i, ttt), 1)) = UCase(TextBox1.Value) Then
            ListBox1.AddItem i
            ListBox1.List(j, 1) = Cells(i, ttt)
            j = j + 1
        End If
    Next i
    'если найден только один эл-т, то переходим к нему
    If j = 1 Then Cells(ListBox1.List(0, 0), ttt).Select
    'Exit Sub
End If

For i = 2 To Cells(Rows.Count, ttt).End(xlUp).Row
    If InStr(1, UCase(Cells(i, ttt)), UCase(TextBox1.Value)) > 0 Then
       ListBox1.AddItem i
       ListBox1.List(j, 1) = Cells(i, ttt)
       j = j + 1
    End If
Next i
   'если найден только один эл-т, то переходим к нему
   If j = 1 Then Cells(ListBox1.List(0, 0), ttt).Select
Next ttt
End Sub