Autocomplete ActiveX combobox

[tiredofit]

I am trying to create an autocompleting ActiveX combobox and have managed to get it to work almost perfectly.

Private Sub ComboBox1_Change()
    Call CreateCustomList
    Me.ComboBox1.DropDown
End Sub

Sub CreateCustomList
    Dim Val As String
    Val = Userform.ComboBox1.Value
    Dim Coll As Collection
    Set Coll = New Collection
    Dim i As Integer
    For i = 2 To 10
        If InStr(1, Sheet1.Cells(i, 1).Value, Val, vbTextCompare) <> 0 Then
            Coll.Add Sheet1.Cells(i, 1).Value
        End If
    Next i
    If Coll.Count <> 0 Then
        Dim DataArray()
        ReDim DataArray(1 To Coll.Count, 1 To 1)
        For i = 1 To Coll.Count
            DataArray(i, 1) = Coll(i)
        Next i
        Sheet2.Cells.ClearContents
        Sheet2.Cells(1, 1).Resize(Coll.Count, 1).Value = DataArray()
        Userform.ComboBox1.List = DataArray()
        Erase DataArray()
        Userform.ComboBox1.ListRows = 8
    Else
        Sheet2.Cells.ClearContents
        Userform.ComboBox1.Clear
        Userform.ComboBox1.ListRows = 1
    End If

    Set Coll = Nothing
    
End Sub

Sheet1 contains these values:

Apple
Apple1
Apple2
Orange
Orange2
Orange3
Pear
Pear2
Pear3

If I fire up the userform and type A into its combobox, the drop down list shows all values that contain the letter A, regardless of the case, which is fine, (so in this case, all 9 values will be shown).

If I type in the next letter p, I only see the Apples and Pears because they're the only ones that contain both the letters A and p, also fine.

Now if I type in the next letter z, nothing shows up, again as expected.

The problem arises if I now delete the letter z.

I expect to see Apples and Pears in the drop down.

Instead, I only see Apple. I have to delete the letter p in order for the drop down to show Apple, Apple1, Apple2, Pear, Pear2, Pear3.

I tried adding these two lines:

        Userform.ComboBox1.ListRows = 8
        Userform.ComboBox1.ListRows = 1

but it didn't help.

Is this a bug or have I missed something?

Thanks

 

[DanteAmor]

Is it a bug that you can to set the focus to another control, then set it back to the combobox?

Apparently if it is a problem of the combobox that does not display all the items, then it is necessary to leave and return.

You can try this other alternative, it is not necessary to leave and return.

Option Explicit
Private IsArrow As Boolean

Private Sub ComboBox1_Change()
  Dim i As Long
  With Me.ComboBox1
    If Not IsArrow Then .List = Sheets("Sheet1").Range("A2:A10").Value
    If .ListIndex = -1 And Val(Len(.Text)) Then
      For i = .ListCount - 1 To 0 Step -1
        If InStr(1, .List(i), .Value, vbTextCompare) = 0 Then .RemoveItem i
      Next i
      .DropDown
    End If
  End With
End Sub

Private Sub UserForm_Initialize()
  ComboBox1.List = Sheets("Sheet1").Range("A2:A10").Value
  ComboBox1.MatchEntry = fmMatchEntryNone
End Sub

 

[tiredofit]

Apparently if it is a problem of the combobox that does not display all the items, then it is necessary to leave and return.

You can try this other alternative, it is not necessary to leave and return.

Option Explicit
Private IsArrow As Boolean

Private Sub ComboBox1_Change()
  Dim i As Long
  With Me.ComboBox1
    If Not IsArrow Then .List = Sheets("Sheet1").Range("A2:A10").Value
    If .ListIndex = -1 And Val(Len(.Text)) Then
      For i = .ListCount - 1 To 0 Step -1
        If InStr(1, .List(i), .Value, vbTextCompare) = 0 Then .RemoveItem i
      Next i
      .DropDown
    End If
  End With
End Sub

Private Sub UserForm_Initialize()
  ComboBox1.List = Sheets("Sheet1").Range("A2:A10").Value
  ComboBox1.MatchEntry = fmMatchEntryNone
End Sub

Thanks, I saw that solution posted before I created my own.