How to use a ComboBox with autocomplete and search as you type.

[dagda13]

Hi,

I have a ComboBox embedded in a worksheet that references a list of items. Ie:

small cat
cat
big cat
small dog
dog
big dog


Right now when I type in 'cat' i only get 'cat' as the suggestion. What I would like is to get all items that contain 'cat'., ie., in this case:

small cat
cat
big cat

Right now I have the "Match Entry" in the ComboBox Properties set to "1 - fmMatchEntryComplete", which allows me to filter by the characters at the beginning of each item, but I can't find a setting or code that will allow me to filter for characters that are contained within the item(s), and not just at the beginning.

Is there a way to do this? Thanks!

 

[John_w]

Try this code. The combo box is an ActiveX Combo Box with the following properties:

Name = ComboBox1
ListFillRange = blank
MatchEntry = 2 - fmMatchEntryNone
MatchRequired = False

The combo box values are in Sheet1 starting at A2 to the last populated cell in column A.

Put this code in the module of the sheet containing the combo box.

Option Explicit

Private IsArrow As Boolean

Private Sub ComboBox1_Change()

    Dim i As Long
    
    If Not IsArrow Then
        With Me.ComboBox1
            .List = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
            .DropDown
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next
                .DropDown
            End If
        End With
    End If
    
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
    If KeyCode = vbKeyReturn Then Me.ComboBox1.List = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
End Sub

 

[John_w]

The combo box is empty when you click its down arrow. Add the following to code to fix this.

Private Sub ComboBox1_DropButtonClick()
    With Me.ComboBox1
        .List = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
        .DropDown
    End With
End Sub

 

[dagda13]

Thanks John, success! Works perfectly.

This is great!

 

[nhantam]

Great work.
It's work for me. Thank you so much

 

[zeromax1]

The combo box is empty when you click its down arrow. Add the following to code to fix this.

Private Sub ComboBox1_DropButt*******()
    With Me.ComboBox1
        .List = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
        .DropDown
    End With
End Sub

Note - the '*******' above should be 'o_nClick', without the underscore.

Hi John, is it possible to press the tab button, then auto complete the combobox content?

 

[John_w]

is it possible to press the tab button, then auto complete the combobox content?

Maybe like this, with a change to ComboBox1_KeyDown. Complete code posted.

Option Explicit

Private IsArrow As Boolean

Private Sub ComboBox1_Change()

    Dim i As Long
  
    If Not IsArrow Then
        With Me.ComboBox1
            .List = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
            .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
            .DropDown
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next
                .DropDown
            End If
            'Debugging
            'Worksheets("Sheet1").Range("Q1:T1").Value = Array("ListCount", "ListRows", "ListIndex", "Text")
            'Worksheets("Sheet1").Range("Q2:T2").Value = Array(.ListCount, .ListRows, .ListIndex, .Text)
        End With
    End If
  
End Sub


Private Sub ComboBox1_DropButtonClick()
    With Me.ComboBox1
        .List = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
        .ListRows = Application.WorksheetFunction.Min(6, .ListCount)
        .DropDown
    End With
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Debug.Print Time; "KeyDown"; KeyCode; ComboBox1.ListIndex; ComboBox1.ListCount, ComboBox1.Value
      
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
  
    If KeyCode = vbKeyReturn Then
        Me.ComboBox1.List = Worksheets("Sheet1").Range("A2", Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp)).Value
    ElseIf KeyCode = vbKeyTab Then
        'Tab key selects first displayed item or highlighted item
        With Me.ComboBox1
            If .ListIndex = -1 Then
                .Value = .List(0)
            Else
                .Value = .List(.ListIndex)
            End If
        End With
        KeyCode = vbKeyReturn
    End If
  
End Sub

 

[zeromax1]

Thank you John,

Excellent

 

[Sergii]

Hi,
Is autocomple possible with combobox in UserForm and source data as a named range?
Thanks a million in advance.

 

[John_w]

Is autocomplete possible with combobox in UserForm and source data as a named range?

Yes, the userform's module code is identical to the worksheet module code in post #7, with the addition of a UserForm_Initialize procedure. Add an (ActiveX) ComboBox control to UserForm1 with the following properties:

Name = ComboBox1
RowSource = blank
MatchEntry = 2 - fmMatchEntryNone
MatchRequired = False

The named range is "ComboBoxData".

UserForm1 module:

Option Explicit

Dim IsArrow As Boolean
Dim ListRowsMaximum As Long


Private Sub UserForm_Initialize()
    With Me.ComboBox1
        ListRowsMaximum = .ListRows
        .List = Range("ComboBoxData").Value
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
    End With
End Sub


Private Sub ComboBox1_Change()

    Dim i As Long
 
    If Not IsArrow Then
        With Me.ComboBox1
            .List = Range("ComboBoxData").Value
            If Len(.Text) Then
                For i = .ListCount - 1 To 0 Step -1
                    If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
                Next
            End If
            .DropDown
            .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
        End With
    End If
 
End Sub


Private Sub ComboBox1_DropButtonClick()

    Dim i As Long
 
    With Me.ComboBox1
        .List = Range("ComboBoxData").Value
        If Len(.Text) Then
            For i = .ListCount - 1 To 0 Step -1
                If InStr(1, .List(i), .Text, vbTextCompare) = 0 Then .RemoveItem i
            Next
        End If
        .DropDown
        .ListRows = Application.WorksheetFunction.Min(ListRowsMaximum, .ListCount)
    End With
 
End Sub


Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 
    IsArrow = (KeyCode = vbKeyUp) Or (KeyCode = vbKeyDown)
 
    If KeyCode = vbKeyReturn Then
        Me.ComboBox1.List = Range("ComboBoxData").Value
    ElseIf KeyCode = vbKeyTab Then
        'Tab key selects first displayed item or highlighted item
        With Me.ComboBox1
            If .ListIndex = -1 Then
                .Value = .List(0)
            Else
                .Value = .List(.ListIndex)
            End If
        End With
        KeyCode = vbKeyReturn
    End If
 
End Sub

Note - There is a bug in the Worksheet module code, which means that the height of the dropdown box doesn't reduce when there are fewer items than the maximum specified (the ListRows property) i.e. the 3 blank lines below 'big top' below. This has been fixed by moving the .ListRows = lines after the .Dropdown lines.