Автозаполнение ячеек, ускорение работы - VBA

Формулировка задачи:

Здравствуйте, подскажите, пожалуйста как можно сделать авто заполнение ячеек как можно удобнее и быстрее. В столбце B "Наименование" я сделал выпадающие списки, данные находятся на листе "Товары". Заполнял я... и понял, что как то медленно это все, список виден только на 8 позиций, и постоянно приходится листать вниз, искать.. на это уходит время. Можно ли сделать, чтобы было видно больше 8 позиций?. А еще лучше, чтобы при написании появлялись варианты предлагающие заполнить. Например начал Яб, появилось яблоки, нажал энтер, заполнилось. Пробовал стандартной ф-цией excel.. но она не показывает варианты если позиций несколько... например у меня в данных фасоль белая и фасоль красная, я начинаю писать ф Ничего не появляется.. оказывается нужно вообще написать фасоль б Чтобы показалась фасоль белая.. это большая затяжка времени. И еще огромнейший минус, авто заполнение идет только если эти данные в том же столбце выше, а если они на другом листе непонятно как их прикрутить. Цель. быстро заполнить столбец Наименование. Хотелось бы через авто заполнение, т.е. начал писать 1-2 букв, энтер, опять 1-2 букв опять энтер.. и так на одном дыхании было бы быстренько. Может кто может подсказать. Формула, макрос, что угодно, лишь бы ускорить работу....... Список на листе "Товары" пополняется

Решение задачи: «Автозаполнение ячеек, ускорение работы»

textual
                            Листинг программы 
                        

                            Private Sub TextBox1_Change()
Dim i As Long, rng As Range, Адрес As String
    ListBox1.Clear
    With Range("Фрукты")
        Set rng = .Find(What:=TextBox1.Value, LookIn:=xlValues, LookAt:=xlPart)
            If Not rng Is Nothing Then
                Адрес = rng.Address
                Do
                   If LCase(Left(rng.Value, 1)) = LCase(Left(TextBox1.Value, 1)) Then
                        ListBox1.AddItem rng
                   End If
                   Set rng = .FindNext(rng)
                Loop While Адрес <> rng.Address
            End If
    End With
End Sub
                        