Excel VBA - автозаполнение строки частичного совпадения

У меня есть несколько списков UserForm, которые нуждаются в функции автозаполнения для частичных совпадений. У меня более 2000 записей, и частичное совпадение строк является основополагающим для пользователей, чтобы найти правильную запись.

Практический пример:

+------------------------+ | Food Market Groceries | +------------------------+ | Matt's Food Inc | +------------------------+ | Groceries for Mamas | +------------------------+ | Alabama Veggies Market |  +------------------------+ 

Когда мы начинаем вводить «ма», все опции с «ма» должны появиться в раскрывающемся списке. В данном случае «рынок», «Мэттс», «Алабама» и «Мамас».

Это мой код формы. Он работает нормально, мне просто нужна дополнительная помощь ComboBox, чтобы решить эту проблему. Диапазон ComboBox устанавливается в свойствах RowSource и тоже работает отлично.

Private Sub btnSubmit_Click()  Dim sheet As Worksheet Dim index As Long  Set sheet = ThisWorkbook.Sheets("Folha2")  'get last position index = LastRow(sheet) + 1  'insert the data sheet.Range("A" & index) = iniciaisTextBox.Value sheet.Range("B" & index) = ComboBox1.Value sheet.Range("C" & index) = TextBox1.Value sheet.Range("D" & index) = DTPicker1.Value sheet.Range("E" & index) = DTPicker2.Value sheet.Range("F" & index) = ComboBox2.Value sheet.Range("G" & index) = ComboBox3.Value sheet.Range("H" & index) = ComboBox4.Value sheet.Range("I" & index) = TextBox4.Value sheet.Range("J" & index) = TextBox5.Value sheet.Range("K" & index) = TextBox6.Value sheet.Range("L" & index) = TextBox7.Value sheet.Range("M" & index) = TextBox8.Value sheet.Range("N" & index) = ComboBox5.Value sheet.Range("O" & index) = TextBox9.Value sheet.Range("P" & index) = ComboBox6.Value sheet.Range("Q" & index) = ComboBox7.Value  'clear the form for new insert clearForm End Sub  Private Sub clearForm() Dim ctrl As Control On Error Resume Next For Each ctrl In Me.Controls If InStr(ctrl.Name, "DTPicker") > 0 Then ctrl.Value = Now Else ctrl.Value = "" End If Next ctrl On Error GoTo 0 End Sub    Private Function LastRow(sheet As Worksheet) Dim rng As Range Set rng = sheet.Cells LastRow = Last(1, rng) End Function  Private Function Last(choice As Long, rng As Range) Dim lrw As Long Dim lcol As Long  Select Case choice  Case 1: On Error Resume Next Last = rng.Find(What:="*", _ After:=rng.Cells(1), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row On Error GoTo 0 End Select End Function 

Какие-нибудь мысли?

Заранее спасибо.