Dynamically populate multiple ComboBoxes

[ibanezhide]

Is there a way to pass on string parameters and reference ComboBoxes dynamically ?

For example:

ComboboxName	Value
Apple	1
Apple	2
Orange	1
Orange	2
Orange	3

Sub Combox_Populate ( ComboBoxName As String )

For i = 1 To UniqueCBCount

Activesheet.ComboBoxName.List() = code

Next

End Sub

Since ComboBoxName is a string, not ComboBox, the statement above doesn't work.

[Kenneth Hobs]

Welcome to the forum!

It is unclear what you mean. What type of control, Form or ActiveX? You can not have duplicate combobox names for neither control type. If you don't control types, see: https://peltiertech.com/forms-contro...rols-in-excel/

You can attach a simple example file if you like. Click Go Advanced button in lower right of a reply. Click paperclip icon in toolbar or Manage Attachments link below the reply box.

[ibanezhide]

Thanks for the reply Kenneth !

Let me try to clarify a bit more, if it is still unclear, I will provide an example file.

Let's say I created two ActiveX combo boxes in a tab:
- 1st combo box name: Apple
- 2nd combo box name: Orange

And I have a data table to specific what values should be assigned to each combo box ( from my first post ), in this case:
- Apple combo box should have values 1 and 2
- Orange combo box should have values 1, 2, and 3

Now I want to use VBA to loop through the data table, and assign the values to each combo box

[Kenneth Hobs]

If you want to automate it further, a worksheet event could look for value changes in columns A or B. You should consider what impacts that would have on current selection list values already set though.

Here is a first blush effort. There are other ways like autofilter or advanced filter.

Sub FillxCBs()  
  Dim s As Shape, a, e, r As Range, c As Range
  On Error Resume Next
  With ActiveSheet
    If .Shapes.Count = 0 Then Exit Sub
    Set r = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
    a = UniqueArrayByDict(r.Value)
    For Each e In a
      Set s = .Shapes(e)
      If s Is Nothing Then GoTo NextE
      If s.Type <> 12 Then GoTo NextE
      .OLEObjects(e).Object.Clear
      For Each c In r
        If s.Name = c.Value2 Then
          .OLEObjects(e).Object.AddItem c.Offset(, 1).Value, -1
        End If
      Next c
NextE:
    Next e
  End With
End Sub


' http://www.excelforum.com/excel-programming-vba-macros/819998-filter-and-sort-scripting-dictionary.html
'Early Binding method requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Function UniqueArrayByDict(Array1d As Variant, Optional compareMethod As Integer = 0) As Variant
  Dim dic As Object 'Late Binding method - Requires no Reference
  Set dic = CreateObject("Scripting.Dictionary")  'Late or Early Binding method
  'Dim dic As Dictionary     'Early Binding method
  'Set dic = New Dictionary  'Early Binding Method
  Dim e As Variant
  dic.CompareMode = compareMethod
  'BinaryCompare=0
  'TextCompare=1
  'DatabaseCompare=2
  For Each e In Array1d
    If Not dic.Exists(e) Then dic.Add e, Nothing
  Next e
  UniqueArrayByDict = dic.Keys
End Function

[snb]

A sample file would save a lot of time/fuzzy communication.

in A2: apple
in A3: orange
in B2: "1 2"
in B3: "1 2 3"

Sub M_snb()
   sn=sheet1.listobjects(1).databodyrange

   for j=1 to ubound(sn)
     sheet1.olebojects(sn(j,1)).object.list=split(sn(j,2))
   next
End Sub

[ibanezhide]

Thanks ! These help a lot, and next time I will upload a sample file to avoid confusion for sure.