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

Question

У меня есть несколько списков 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

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

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