Search code examples
excelvbacollectionsdrop-down-menusearchable-dropdown

Searchable combobox not working with collection


I have a dropdown that before was being populated with values from a second sheet in my workbook using the following code:

Private Sub UserForm_Initialize()

Dim cProd As Range
Dim ws As Worksheet
Dim i As Long

Set ws = ThisWorkbook.Worksheets("DO NOT DELETE")

For Each cProd In ws.Range("ProdList")
    With Me.dropProd
        .AddItem cProd.Value
    End With
Next cProd

Me.dropProd.SetFocus

End Sub

Then, I added the code I found here to add the searchable functionality to it, and it was working just fine.

Then I had to tweak my code to add a second dropdown that would be dependent on the first one that I had previously. To do that, I deleted that DO NOT DELETE worksheet, and created two collections to store the values for the dropdowns.

Now, my first dropdown is being populated in this code:

Sub UpdateAll()

Dim ProdID As String
Dim Prod As String
Dim TF As Boolean
Dim lRow As Long
Dim i, t, s
    
dropProd.Clear
dropPromo.Clear
   
Set ws = ThisWorkbook.Worksheets("Table View")
   
Set cProd = New Collection
    
lRow = ws.Cells(Rows.Count, 1).End(-4162).Row
    
For i = 13 To lRow
    
    ProdID = ws.Cells(i, 2).Value
    Prod = ws.Cells(i, 3).Value

    If ProdID <> "" Then
            
        TF = False
        If cProd.Count <> 0 Then
            For t = 1 To cProd.Count
                If cProd(t) = ProdID & " - " & Prod Then TF = True
            Next
        End If

        If TF = False Then cProd.Add (ProdID & " - " & Prod)
    End If
    Next

For s = 1 To cProd.Count
        dropProd.AddItem (cProd(s))
Next

End Sub

Private Sub UserForm_Initialize()

    Me.dropProd.SetFocus
    UpdateAll 

End Sub

This part is also doing great, the below is where I'm having trouble with:

Private Sub dropProd_Change()

    Dim ProdInfo As String
    Dim Promo As String
    Dim q, p

    dropPromo.Clear

    lRow = ws.Cells(Rows.Count, 1).End(-4162).Row
    
    If dropProd.Value <> "" Then
        ProdInfo = Mid(dropProd.Value, 1, InStr(1, dropProd.Value, " - ") - 1)
    End If

    'Populates Promo ComboBox
    For q = 13 To lRow

        Promo = ws.Cells(q, 9).Value
        
        If ws.Cells(q, 2).Value = ProdInfo Then dropPromo.AddItem Promo

    Next

End Sub

The above works fine if I just select the value from the dropdown, but it breaks every time I try to search anything, and the problem is in this line ProdInfo = Mid(dropProd.Value, 1, InStr(1, dropProd.Value, " - ") - 1)

I've tried to rewrite it in another way, but it's still throwing me an error. Also, I tried to incorporate the code from the link above to see if it would work, but then I didn't know what to reference on me.dropProd.List = ????. I've tried haing this equals to the Collection I have, and of course it didn't work, and now I'm stuck on how to fix it.


Solution

  • I couldn't reproduce the problem with your code line ProdInfo = Mid(dropProd.Value, 1, InStr(1, dropProd.Value, " - ") - 1), it might be data related. Try this alternative ProdInfo = Trim(Split(dropProd.Value, "-")(0)) and a dictionary rather than a collection.

    Option Explicit
    Dim ws
    
    Sub UpdateAll()
    
        Dim ProdID As String, Prod As String
        Dim lastrow As Long, i As Long
          
        dropProd.Clear
        dropPromo.Clear
        
        Dim dictProd As Object, k As String
        Set dictProd = CreateObject("Scripting.DIctionary")
           
        Set ws = ThisWorkbook.Worksheets("Table View")
        With ws
            lastrow = ws.Cells(.Rows.Count, 1).End(xlUp).Row
            For i = 13 To lastrow
                ProdID = Trim(.Cells(i, 2))
                If Len(ProdID) > 0 Then
                    Prod = Trim(.Cells(i, 3))
                    k = ProdID & " - " & Prod
                    If Not dictProd.exists(k) Then
                        dictProd.Add k, 1
                    End If
                End If
            Next
            dropProd.List = dictProd.keys
        End With
    
    End Sub
    
    Private Sub dropProd_Change()
    
        Dim ProdInfo As String, Promo As String
        Dim lastrow As Long, i As Long
        
        dropPromo.Clear
        
        If dropProd.Value <> "" Then
            ProdInfo = Trim(Split(dropProd.Value, "-")(0))
        
            'Populates Promo ComboBox
            With ws
                lastrow = ws.Cells(.Rows.Count, 1).End(xlUp).Row
                For i = 13 To lastrow
                    If .Cells(i, 2).Value = ProdInfo Then
                        Promo = ws.Cells(i, 9).Value
                        dropPromo.AddItem Promo
                    End If
                Next
            End With
        End If
    End Sub
    
    Private Sub UserForm_Initialize()
        Me.dropProd.SetFocus
        UpdateAll
    End Sub