Private Sub TextBox1_Change()
    Dim i As Integer
    ListBox1.Clear    'очищаем листбокс
    'при отсутствии символов для поиска - выход
    If Len(TextBox1.Value) = 0 Then Exit Sub
    'осуществляем поиск, заполняем листбокс
    For i = 1 To UBound(x, 1)
        If UCase(x(i, 1)) Like "*" & UCase(TextBox1.Value) & "*" Then
            ListBox1.AddItem x(i, 1)
        End If
    Next i
End Sub

Private Sub ListBox1_Click()
    Dim k As Integer
    If ListBox1.ListIndex = -1 Then Exit Sub
    k = WorksheetFunction.Match(Me.ListBox1.Value, x, 0)
    'данные начинаются с 7-й строки
    Cells(k + 4, 1).Select
End Sub

ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count