Home > database >  Searchable combobox not working with collection
Searchable combobox not working with collection

Time:01-28

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.

CodePudding user response:

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
  • Related