Hello 10shlomi10,
The attached workbook is a start to what you want to accomplish but still needs work. I thought you would like see something working and know it is possible.
Here is the code...
UserForm2 Code
Dim ufCtrls As Collection
Sub SetupComboBoxes()
Dim cbo As MSForms.ComboBox
Dim myTable As ListObject
Dim n As Long
Dim ufCtrl As clsUFcombobox
Set ufCtrls = New Collection
Set myTable = ActiveSheet.ListObjects(1)
For n = 1 To myTable.ListColumns.Count
Set cbo = Me.Controls.Add("Forms.combobox.1")
With cbo
.Name = "cmbSBG_" & n
.Left = Me.cmbMainGroup.Left
.Width = Me.cmbMainGroup.Width
.Height = Me.cmbMainGroup.Height
.Top = Me.cmbMainGroup.Top + (n * Me.cmbMainGroup.Height) + (n * 5)
End With
Set ufCtrl = New clsUFcombobox
Set ufCtrl.ComboBox = cbo
Set ufCtrl.ListObject = ThisWorkbook.Worksheets("AccIndex").ListObjects(1)
ufCtrl.Column = n
ufCtrls.Add ufCtrl, cbo.Name
Next n
End Sub
Private Sub cmbMainGroup_Change()
Dim icntr As Long
Dim jcntr As Long
Dim Keys As Variant
Dim myTable As Variant
myTable = ActiveSheet.ListObjects(1).DataBodyRange
With CreateObject("Scripting.Dictionary")
For jcntr = 2 To UBound(myTable, 2)
For icntr = 1 To UBound(myTable, 1)
If myTable(icntr, 1) = Me.cmbMainGroup And Not .Exists(myTable(icntr, jcntr)) Then .Add myTable(icntr, jcntr), myTable(icntr, jcntr) & "_content"
Next icntr
Keys = .Keys
With Me.Controls("cmbSBG_" & jcntr)
.Clear
.List = Application.Transpose(Keys)
End With
.RemoveAll
Next jcntr
End With
End Sub
Private Sub UserForm_Initialize()
Dim Cell As Range
Dim Headers As Range
Dim icntr As Long
Dim myTable As Variant
' Headers are in the top row of the table.
Set Headers = ActiveSheet.ListObjects(1).HeaderRowRange
myTable = ActiveSheet.ListObjects(1).DataBodyRange
'Step 1: Populate the Group Combo
With CreateObject("Scripting.Dictionary")
For icntr = 1 To UBound(myTable, 1)
If Not .Exists(myTable(icntr, 1)) Then .Add myTable(icntr, 1), myTable(icntr, 1) & "_content"
Next icntr
Me.cmbMainGroup.List = Application.Transpose(.Keys)
End With
' Create the ComboBoxes for this table.
Call SetupComboBoxes
' Copy the column headers from the table to the labels on the UserForm.
For icntr = 1 To UBound(myTable, 2) ' for each sub group
With Me.Controls.Add("Forms.label.1")
.Name = "lblSBG_" & icntr
.Caption = Headers.Cells(1, icntr).Value
.TextAlign = 3
.Left = Me.lblMainGroup.Left
.Width = Me.lblMainGroup.Width
.Height = Me.cmbMainGroup.Height
.Top = Me.cmbMainGroup.Top + (icntr * Me.cmbMainGroup.Height) + (icntr * 5) + 10
End With
Next icntr
Me.ScrollHeight = icntr * 100
Me.ScrollBars = fmScrollBarsVertical
End Sub
Class Module clsUFcombobox Code
Public WithEvents ComboBox As MSForms.ComboBox
Dim pvtColumn As Long
Dim pvtListObject As Object
Private Sub ComboBox_Change()
Dim LastRow As Long
With pvtListObject.DataBodyRange
LastRow = .Rows(.Rows.Count).row - .row + 1
.Cells(LastRow, pvtColumn).Value = ComboBox.Value
End With
End Sub
Property Let Column(ByVal col As Long)
pvtColumn = col
End Property
Property Get Column() As Long
Column = pvtColumn
End Property
Property Set ListObject(ByRef obj As Object)
If pvtListObject Is Nothing Then
Set pvtListObject = obj
Else
MsgBox "Property is Read Only.", vbExclamation
End If
End Property
Property Get ListObject() As Object
Set ListObject = pvtListObject
End Property
Reply With Quote
