Combobox с поиском на VBA

Private Sub ComboBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger) 'процедура срабатывает событие нажатия клавиши с клавиатуры
 Dim n As Integer, str1, str2 As String, a As Integer 'str1 - строка в которой ищем; str2 - искомый набор символов; n - количество строк в списке слов
 ComboBox1.Clear 'очищаем комбо-бокс
 Application.ScreenUpdating = False
 ComboBox1.Text = str2 'сохраняем введенное значение в комбо-бокс в переменную
 For n = 2 To 7 'цикл проверки введенных в комбо-бокс значений на наличие в списке слов. Если слово содержит введенные символы - слово добавляется в список значений комбо-бокс
   str1 = Cells(n, 1).Text
   If InStr(1, str1, str2, vbTextCompare) <> 0 Then ComboBox1.AddItem str1
   Next n
 Application.ScreenUpdating = True
 ComboBox1.DropDown 'открываем список найденных значений в комбо-бокс
End Sub

Private Sub TextBox1_Change()
Dim i As Long, rng As Range, Адрес As String
If k = 0 Then MsgBox "Выберите критерий": Exit Sub
ListBox1.Clear
 
With Range(Cells(2, k), Cells(Cells(Rows.Count, k).End(xlUp).Row, k))
    Set rng = .Find(What:=TextBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
        If Not rng Is Nothing Then
'        MsgBox rng.Address
            Адрес = rng.Address
            Do
                If NAT.Value = False Or UCase(TextBox1.Text) = UCase(Left(rng.Value, Len(TextBox1.Text))) Then
                ListBox1.AddItem Cells(rng.Row, 2)
             ListBox1.AddItem rng.Row
              ListBox1.List(i, 1) = rng.Row
               ListBox1.List(i, 2) = Cells(rng.Row, 2)
                ListBox1.List(i, 3) = Cells(rng.Row, 4)
                  ListBox1.List(i, 4) = Cells(rng.Row, 3)
                i = i + 1
                End If
               Set rng = .FindNext(rng)
            Loop While Адрес <> rng.Address
        End If
End With
 
'If i = 1 Then Cells(ListBox1.List(0, 0), k).Select
 
End Sub

Private Sub TextBox1_Change()
Dim i As Integer, WholeRange As Range
If TextBox1.Text = "" Then Exit Sub
ListBox1.Clear
i = 0
Set WholeRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
For Each cell In WholeRange
If InStr(1, cell.Text, TextBox1.Text, vbTextCompare) <> 0 Then
ListBox1.AddItem cell.Text
ListBox1.List(i, 1) = Cells(WholeRange.Row, 1)
i = i + 1
End If
Next
End Sub

Private Sub TextBox1_Change()
Dim i As Long, rng As Range, Адрес As String
ListBox1.Clear
With Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    Set rng = .Find(What:=TextBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
        If Not rng Is Nothing Then
            Адрес = rng.Address
            Do
                ListBox1.AddItem rng
               Set rng = .FindNext(rng)
            Loop While Адрес <> rng.Address
        End If
End With
End Sub

ListBox1.AddItem rng & " " & Cells(rng.Row, 2) & " " & Cells(rng.Row, 3)

ListBox1.AddItem 
ListBox1.List(ListBox1.ListCount - 1, 0) = Cells(rng.Row, 1)
ListBox1.List(ListBox1.ListCount - 1, 1) = Cells(rng.Row, 2)
ListBox1.List(ListBox1.ListCount - 1, 2) = Cells(rng.Row, 3)