Add a dependent dropdown on UserForm with list constantly changing

probexcel

New Member
Joined
Nov 16, 2022
Messages
14
Office Version
  1. 365
Platform
  1. Windows
Hi,

I have a spreadsheet containing a list of products and Promotions. Each product can have multiple promotions, and one promotion can be found in different products (many-to-many). This spreadsheet is updated constantly.

I created a UserForm with a dropdown list containing unique products. For that, I created a second spreadsheet and used "=UNIQUE(Price[[#All],[Product ID]]&" - "&Price[[#All],[Product_Description]])". I added this range to the Name Manager and populated the dropdown. I did it like that because the products change a lot, the dropdown needs to reflect that, and I was out of ideas.

The initial idea for this was to use VBA to insert a new line after the last row of the product from the dropdown list, something like:
ProductPromotion
Product APromotion 1
Product APromotion 2
Product ANew Promotion
Product BPromotion 3
where the italic and underlined line is the inserted line.

But the promotions have a very different type of order that needs to be respected, so I was asked if I could create a second dropdown where they pick the product and the promotion, this way if they pick Product A, and Promotion 1, the line will be inserted after Promotion 1, and not at the end, just like that:
ProductPromotion
Product APromotion 1
Product ANew Promotion
Product APromotion 2
Product BPromotion 3

My solution was to just create another UNIQUE range for the promotion, save it under the name manager and use it to add a new line. But then, when I pick Product A and I go to the second dropdown to pick promotion, I still see "Promotion 3" because they are not tied together.

What I want to do now is to have the promotions dropdown tied to the products dropdown, so it would only show the promotions for the product they selected before, instead of showing all promotions from every product.

This is how my code looks like now:
VBA Code:
Private Sub UserForm_Initialize()
    
    Dim cProd As Range
    Dim cPromo 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
    
    For Each cPromo In ws.Range("PromoList")
        With Me.dropPromo
            .AddItem cPromo.Value
        End With
    Next cPromo
    
    Me.dropProd.SetFocus
    
End Sub
------------------------------------------------------------------------------------------------------
Private Sub dropProd_Change()

    Dim ws As Worksheet
    Dim i As Long

    Set ws = ThisWorkbook.Worksheets("DO NOT DELETE")
    
    If Not IsArrow Then
        With Me.dropProd
            .List = ws.Range("ProdList").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 dropPromo_Change()

    Dim ws As Worksheet
    Dim i As Long

    Set ws = ThisWorkbook.Worksheets("DO NOT DELETE")
    
    If Not IsArrow Then
        With Me.dropPromo
            .List = ws.Range("PromoList").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 cmdAdd_Click()

    Dim LastRow As Long, lProd As Long, lPromo As Long
    Dim ProdCell As Range, PromoCell As Range
    Dim wsTable As Worksheet
    
    Set wsTable = ThisWorkbook.Worksheets("Table View")
    
    Application.ScreenUpdating = False
    
    LastRow = wsTable.Cells(Rows.Count, 1).End(-4162).Row
    
    lProd = Me.dropProd.ListIndex
    lPromo = Me.dropPromo.ListIndex
    
    'Check for a Product Description
    If Trim(Me.dropProd.Value) = "" Then
        Me.dropProd.SetFocus
        MsgBox "Please, select a product"
        Exit Sub
    End If
    
    If Trim(Me.dropPromo.Value) = "" Then
        Me.dropPromo.SetFocus
        MsgBox "Please, select a promotion"
        Exit Sub
    End If
    
    Set ProdCell = wsTable.Range("B13:B" & LastRow).Find(CInt(Trim(Split(Me.dropProd.Value, " - ")(0))))
    
    For Each PromoCell In ProdCell.Offset(0, 7)
    
        If PromoCell.Value = Me.dropPromo.Value Then
            'Add Row
            wsTable.Rows(PromoCell.Row).Insert
                    
            'Copy data
            wsTable.Rows(PromoCell.Row).Copy Rows(PromoCell.Row - 1)
            wsTable.Cells(PromoCell.Row, "H").Formula = ""
            wsTable.Cells(PromoCell.Row, "I").Formula = "New Promo"
            wsTable.Cells(PromoCell.Row, "J").Formula = ""
                    
            Application.ScreenUpdating = True
                    
            MsgBox ("A new promotion was successfully added!")
                
            Exit Sub
                
        Else
        
            MsgBox "There's no Promo with this name for the selected product!"
            
        End If
    
    Next PromoCell
    
    'Clear Prompt Box
    Me.dropProd.Value = ""
    
    Application.ScreenUpdating = True
    
End Sub


Any ideas on how make the code better is also welcome.
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Here is what I did, or, at least, what I would do.

I would utilize collections. Collections are basically list. By using them you can easily store collections of data, like promo codes or product codes.

VBA Code:
Dim CB1 As Collection
Dim CB2 As Collection
Dim CB3 As Collection

Using these I would populate a combobox as needed. Here I have given you two examples. The first example, which is what I would do to save time, is to combine both the product and promo code together and use a common separator (like " | " in my example). Then you can easily reverse the string to gather the product and promo.

Or you can have both listed in its own combobox using the collections.

You will want to make sure you dont have doubles, so a quick look through the existing collection can verify you do not have dupes.

VBA Code:
Sub UpdateAll()

    ComboBox1.Clear
    ComboBox2.Clear
    ComboBox3.Clear
   
   
    Set ws = ThisWorkbook.Worksheets("Sheet4")
   
    Set CB1 = New Collection
    Set CB2 = New Collection
    Set CB3 = New Collection
   
   
    For i = 2 To 10
        Dim Prod As String
        Prod = ws.Cells(i, 1).Value
       
        Dim Promo As String
        Promo = ws.Cells(i, 2).Value
       
        'if no product listed then nothing
        If Prod <> "" Then
            CB1.Add (Prod & " | " & Promo)      'adds both to list
           
            Dim TF As Boolean
            TF = False
            If CB2.Count <> 0 Then
                For t = 1 To CB2.Count
                    If CB2(t) = Prod Then TF = True
                Next
            End If
           
            If TF = False Then CB2.Add (Prod)     'adds product if not already there
        End If
    Next
   
   
    'add in both to one
    For i = 1 To CB1.Count
        ComboBox1.AddItem (CB1(i))
    Next

    'add product
    For i = 1 To CB2.Count
        ComboBox2.AddItem (CB2(i))
    Next

End Sub

I did not include this, but you can easily have a textbox you can custom name your promo. For this example, I didnt think it was needed.

if you go with the first option (having both in the same combobox) then you can program your button to separate the string, search for each, and then add a new row as needed.

VBA Code:
Private Sub CommandButton1_Click()

    Dim Prod As String
    Dim Promo As String
    Dim Str As String
    Dim Dev As String
    Dim Sep As Integer
   
    Dev = " | "
    Str = ComboBox1.Value
    Sep = InStr(1, Str, Dev)
   
    'this breaks down the two to search for
    Prod = Mid(Str, 1, Sep - 1)
    Promo = Mid(Str, Len(Prod) + Len(Dev) + 1, 100)
   
    SearchAndAdd Prod, Promo
   
End Sub

Sub SearchAndAdd(Product As String, Promo As String)

    Dim R As Integer
    R = 2
    'this look looks for it
    For i = 2 To 100
        If ws.Cells(i, 1).Value = Product And ws.Cells(i, 2).Value = Promo Then
            R = i
            Exit For
        End If
    Next

    InsertRow R, Product, "NEW PROMO"
    UpdateAll
   
End Sub

Sub InsertRow(RowNum As Integer, Product As String, Promo As String)
   
    ws.Rows(RowNum).Insert
    ws.Cells(RowNum, 1).Value = Product
    ws.Cells(RowNum, 2).Value = Promo
   
   
End Sub


if you choose the second option (having two comboboxs) then you need to update the promo combobox with every selection in the product combobox.

VBA Code:
Private Sub ComboBox2_Change()
   
    ComboBox3.Clear
   
    Dim Prod As String
    Prod = ComboBox2.Value
   
    Dim Promo As String
   
    'this checks to see if the product matches the combobox and then adds to the other box the promo
    For i = 2 To 10
        Promo = ws.Cells(i, 2).Value
        If Prod = ws.Cells(i, 1).Value Then ComboBox3.AddItem Promo
    Next
   
End Sub

Once that is done, just search for both values and add in the row/data as needed.

I also added in to reset everything once a new row was added. This way the userform and comboboxs would always be up to date.

What I have in this userform is 2 labels, 3 comboboxs and 2 buttons. Default names.

Again, this is an example, but it should get you on the right path.


-----------------------------------
Full Code
-----------------------------------

VBA Code:
Dim CB1 As Collection
Dim CB2 As Collection
Dim CB3 As Collection

Dim ws As Worksheet


Private Sub CommandButton2_Click()
   
    If ComboBox3.Value = "" Then Exit Sub
   
    SearchAndAdd ComboBox2.Value, ComboBox3.Value

End Sub

Sub UpdateAll()

    ComboBox1.Clear
    ComboBox2.Clear
    ComboBox3.Clear
   
   
    Set ws = ThisWorkbook.Worksheets("Sheet4")
   
    Set CB1 = New Collection
    Set CB2 = New Collection
    Set CB3 = New Collection
   
   
    For i = 2 To 10
        Dim Prod As String
        Prod = ws.Cells(i, 1).Value
       
        Dim Promo As String
        Promo = ws.Cells(i, 2).Value
       
        'if no product listed then nothing
        If Prod <> "" Then
            CB1.Add (Prod & " | " & Promo)      'adds both to list
           
            Dim TF As Boolean
            TF = False
            If CB2.Count <> 0 Then
                For t = 1 To CB2.Count
                    If CB2(t) = Prod Then TF = True
                Next
            End If
           
            If TF = False Then CB2.Add (Prod)     'adds product if not already there
        End If
    Next
   
   
    'add in both to one
    For i = 1 To CB1.Count
        ComboBox1.AddItem (CB1(i))
    Next

    'add product
    For i = 1 To CB2.Count
        ComboBox2.AddItem (CB2(i))
    Next

End Sub

Private Sub UserForm_Initialize()

    UpdateAll
   

End Sub

Private Sub ComboBox2_Change()
   
    ComboBox3.Clear
   
    Dim Prod As String
    Prod = ComboBox2.Value
   
    Dim Promo As String
   
    'this checks to see if the product matches the combobox and then adds to the other box the promo
    For i = 2 To 10
        Promo = ws.Cells(i, 2).Value
        If Prod = ws.Cells(i, 1).Value Then ComboBox3.AddItem Promo
    Next
   
End Sub



Private Sub CommandButton1_Click()

    Dim Prod As String
    Dim Promo As String
    Dim Str As String
    Dim Dev As String
    Dim Sep As Integer
   
    Dev = " | "
    Str = ComboBox1.Value
    Sep = InStr(1, Str, Dev)
   
    'this breaks down the two to search for
    Prod = Mid(Str, 1, Sep - 1)
    Promo = Mid(Str, Len(Prod) + Len(Dev) + 1, 100)
   
    SearchAndAdd Prod, Promo
   
End Sub

Sub SearchAndAdd(Product As String, Promo As String)

    Dim R As Integer
    R = 2
    'this look looks for it
    For i = 2 To 100
        If ws.Cells(i, 1).Value = Product And ws.Cells(i, 2).Value = Promo Then
            R = i
            Exit For
        End If
    Next

    InsertRow R, Product, "NEW PROMO"
    UpdateAll
   
End Sub

Sub InsertRow(RowNum As Integer, Product As String, Promo As String)
   
    ws.Rows(RowNum).Insert
    ws.Cells(RowNum, 1).Value = Product
    ws.Cells(RowNum, 2).Value = Promo
   
   
End Sub
 

Attachments

  • Capture1.JPG
    Capture1.JPG
    45 KB · Views: 22
  • Capture2.JPG
    Capture2.JPG
    77.7 KB · Views: 24
  • Capture3.JPG
    Capture3.JPG
    73 KB · Views: 24
  • Capture4.JPG
    Capture4.JPG
    94.6 KB · Views: 21
  • Capture5.JPG
    Capture5.JPG
    107 KB · Views: 23
Upvote 0
Solution
Here is what I did, or, at least, what I would do.

I would utilize collections. Collections are basically list. By using them you can easily store collections of data, like promo codes or product codes.

VBA Code:
Dim CB1 As Collection
Dim CB2 As Collection
Dim CB3 As Collection

Using these I would populate a combobox as needed. Here I have given you two examples. The first example, which is what I would do to save time, is to combine both the product and promo code together and use a common separator (like " | " in my example). Then you can easily reverse the string to gather the product and promo.

Or you can have both listed in its own combobox using the collections.

You will want to make sure you dont have doubles, so a quick look through the existing collection can verify you do not have dupes.

VBA Code:
Sub UpdateAll()

    ComboBox1.Clear
    ComboBox2.Clear
    ComboBox3.Clear
  
  
    Set ws = ThisWorkbook.Worksheets("Sheet4")
  
    Set CB1 = New Collection
    Set CB2 = New Collection
    Set CB3 = New Collection
  
  
    For i = 2 To 10
        Dim Prod As String
        Prod = ws.Cells(i, 1).Value
      
        Dim Promo As String
        Promo = ws.Cells(i, 2).Value
      
        'if no product listed then nothing
        If Prod <> "" Then
            CB1.Add (Prod & " | " & Promo)      'adds both to list
          
            Dim TF As Boolean
            TF = False
            If CB2.Count <> 0 Then
                For t = 1 To CB2.Count
                    If CB2(t) = Prod Then TF = True
                Next
            End If
          
            If TF = False Then CB2.Add (Prod)     'adds product if not already there
        End If
    Next
  
  
    'add in both to one
    For i = 1 To CB1.Count
        ComboBox1.AddItem (CB1(i))
    Next

    'add product
    For i = 1 To CB2.Count
        ComboBox2.AddItem (CB2(i))
    Next

End Sub

I did not include this, but you can easily have a textbox you can custom name your promo. For this example, I didnt think it was needed.

if you go with the first option (having both in the same combobox) then you can program your button to separate the string, search for each, and then add a new row as needed.

VBA Code:
Private Sub CommandButton1_Click()

    Dim Prod As String
    Dim Promo As String
    Dim Str As String
    Dim Dev As String
    Dim Sep As Integer
  
    Dev = " | "
    Str = ComboBox1.Value
    Sep = InStr(1, Str, Dev)
  
    'this breaks down the two to search for
    Prod = Mid(Str, 1, Sep - 1)
    Promo = Mid(Str, Len(Prod) + Len(Dev) + 1, 100)
  
    SearchAndAdd Prod, Promo
  
End Sub

Sub SearchAndAdd(Product As String, Promo As String)

    Dim R As Integer
    R = 2
    'this look looks for it
    For i = 2 To 100
        If ws.Cells(i, 1).Value = Product And ws.Cells(i, 2).Value = Promo Then
            R = i
            Exit For
        End If
    Next

    InsertRow R, Product, "NEW PROMO"
    UpdateAll
  
End Sub

Sub InsertRow(RowNum As Integer, Product As String, Promo As String)
  
    ws.Rows(RowNum).Insert
    ws.Cells(RowNum, 1).Value = Product
    ws.Cells(RowNum, 2).Value = Promo
  
  
End Sub


if you choose the second option (having two comboboxs) then you need to update the promo combobox with every selection in the product combobox.

VBA Code:
Private Sub ComboBox2_Change()
  
    ComboBox3.Clear
  
    Dim Prod As String
    Prod = ComboBox2.Value
  
    Dim Promo As String
  
    'this checks to see if the product matches the combobox and then adds to the other box the promo
    For i = 2 To 10
        Promo = ws.Cells(i, 2).Value
        If Prod = ws.Cells(i, 1).Value Then ComboBox3.AddItem Promo
    Next
  
End Sub

Once that is done, just search for both values and add in the row/data as needed.

I also added in to reset everything once a new row was added. This way the userform and comboboxs would always be up to date.

What I have in this userform is 2 labels, 3 comboboxs and 2 buttons. Default names.

Again, this is an example, but it should get you on the right path.


-----------------------------------
Full Code
-----------------------------------

VBA Code:
Dim CB1 As Collection
Dim CB2 As Collection
Dim CB3 As Collection

Dim ws As Worksheet


Private Sub CommandButton2_Click()
  
    If ComboBox3.Value = "" Then Exit Sub
  
    SearchAndAdd ComboBox2.Value, ComboBox3.Value

End Sub

Sub UpdateAll()

    ComboBox1.Clear
    ComboBox2.Clear
    ComboBox3.Clear
  
  
    Set ws = ThisWorkbook.Worksheets("Sheet4")
  
    Set CB1 = New Collection
    Set CB2 = New Collection
    Set CB3 = New Collection
  
  
    For i = 2 To 10
        Dim Prod As String
        Prod = ws.Cells(i, 1).Value
      
        Dim Promo As String
        Promo = ws.Cells(i, 2).Value
      
        'if no product listed then nothing
        If Prod <> "" Then
            CB1.Add (Prod & " | " & Promo)      'adds both to list
          
            Dim TF As Boolean
            TF = False
            If CB2.Count <> 0 Then
                For t = 1 To CB2.Count
                    If CB2(t) = Prod Then TF = True
                Next
            End If
          
            If TF = False Then CB2.Add (Prod)     'adds product if not already there
        End If
    Next
  
  
    'add in both to one
    For i = 1 To CB1.Count
        ComboBox1.AddItem (CB1(i))
    Next

    'add product
    For i = 1 To CB2.Count
        ComboBox2.AddItem (CB2(i))
    Next

End Sub

Private Sub UserForm_Initialize()

    UpdateAll
  

End Sub

Private Sub ComboBox2_Change()
  
    ComboBox3.Clear
  
    Dim Prod As String
    Prod = ComboBox2.Value
  
    Dim Promo As String
  
    'this checks to see if the product matches the combobox and then adds to the other box the promo
    For i = 2 To 10
        Promo = ws.Cells(i, 2).Value
        If Prod = ws.Cells(i, 1).Value Then ComboBox3.AddItem Promo
    Next
  
End Sub



Private Sub CommandButton1_Click()

    Dim Prod As String
    Dim Promo As String
    Dim Str As String
    Dim Dev As String
    Dim Sep As Integer
  
    Dev = " | "
    Str = ComboBox1.Value
    Sep = InStr(1, Str, Dev)
  
    'this breaks down the two to search for
    Prod = Mid(Str, 1, Sep - 1)
    Promo = Mid(Str, Len(Prod) + Len(Dev) + 1, 100)
  
    SearchAndAdd Prod, Promo
  
End Sub

Sub SearchAndAdd(Product As String, Promo As String)

    Dim R As Integer
    R = 2
    'this look looks for it
    For i = 2 To 100
        If ws.Cells(i, 1).Value = Product And ws.Cells(i, 2).Value = Promo Then
            R = i
            Exit For
        End If
    Next

    InsertRow R, Product, "NEW PROMO"
    UpdateAll
  
End Sub

Sub InsertRow(RowNum As Integer, Product As String, Promo As String)
  
    ws.Rows(RowNum).Insert
    ws.Cells(RowNum, 1).Value = Product
    ws.Cells(RowNum, 2).Value = Promo
  
  
End Sub
That's great. Thank you so much for that.

Another problem, if I'm not asking too much. I worked on your solution and kept 2 dropdowns, but with the first one working similarly to what you have on the ComboBox1 (combined columns). So I have ComboBox1 being columns 1 and 2 (Product ID and Product Description), and ComboBox2 being Promotion.

I had the code below so it could be a searchable dropdown:
VBA Code:
Private IsArrow as Boolean

Private Sub ComboBox1_Change()

    Dim i As Long
   
    If Not IsArrow Then
        With Me.ComboBox1
            .List = ws.Range("ProdList").Value    'the range that now became the collection
            .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

Which I updated to:
VBA Code:
Private Sub ComboBox1_Change()

    Dim ProdInfo As String
    Dim Promo As String
    Dim q As Integer
    Dim p As Integer

    ComboBox2.Clear

    lRow = ws.Cells(Rows.Count, 1).End(-4162).Row
   
    'this is because it was throwing me an error when I was trying to add a new promo
    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 ComboBox2.AddItem Promo

    Next

End Sub

So now, when I try to search, this line here ProdInfo = Mid(dropProd.Value, 1, InStr(1, dropProd.Value, " - ") - 1) will give me an error. How can I merge those 2 codes together to have the searchable dropdown again?
 
Upvote 0
searchable dropdown again?
inside your userform, select the combobox you want to be searchable and change the following property from the Properties Window:

MatchEntry: 1 - fmMatchEntryComplete
MathRequired: False

That should allow you to start typing in the combobox and enable search/auto fill.

As for the error, I dont see how the code you provided would error out. It would be easier to see the whole thing. Have you tried to do a break and see what error it was giving you? Or, declare the MID as a string and see if it is possibly an incorrect location or variable?
 
Upvote 0
Th
inside your userform, select the combobox you want to be searchable and change the following property from the Properties Window:

MatchEntry: 1 - fmMatchEntryComplete
MathRequired: False

That should allow you to start typing in the combobox and enable search/auto fill.

As for the error, I dont see how the code you provided would error out. It would be easier to see the whole thing. Have you tried to do a break and see what error it was giving you? Or, declare the MID as a string and see if it is possibly an incorrect location or variable?
Thank you so much for your help. I tried to change those properties but it didn't work. But I used your help and changed the collection to a dictionary where I was able to implement the other part of the code. I appreciate so much, your first answer was key.
 
Upvote 0
You can also try the builtin AutoWorkSelect boolean

VBA Code:
    ComboBox1.AutoWordSelect = True
 
Upvote 0

Forum statistics

Threads
1,224,817
Messages
6,181,149
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top