Excel VBA - string de correspondência parcial de preenchimento automático

Question

Eu tenho algumas Comboboxes de UserForm que precisam de um recurso de preenchimento automático para correspondências parciais. Tenho mais de 2000 entradas e a correspondência parcial de string é fundamental para que os usuários encontrem a entrada correta.

Um exemplo prático:

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

Quando começamos a digitar "ma", todas as opções com "ma" devem aparecer no menu suspenso. Neste caso, "mercado", "Matt", "Alabama" e "Mamas".

Este é o meu código de formulário. Está funcionando bem, eu só preciso de uma ajuda extra do ComboBox para resolver isso. O intervalo ComboBox está definido nas propriedades RowSource e está funcionando bem também.

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

Alguma opinião?

Obrigado antecipadamente.