Create Dynamic User Form with two Dependent Combo Boxes

Опубликовано: 12 Октябрь 2024
на канале: Dinesh Kumar Takyar

4,047

How to create a dynamic user form with two dependent combo boxes which will be populated with data at run time. Here's the complete VBA code:
Sub UserFormWithTwoDynamicComboBoxes()

Dim newForm As Object

'Create a new user form

Set newForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)

'We set the form's properties
With newForm
.Properties("Caption") = "Runtime Combo Boxes"
.Properties("Width") = 250
.Properties("Height") = 150
.Properties("Top") = 150
.Properties("Left") = 850
End With

'Add the first Combo Box for items
Set itemComboBox = newForm.designer.Controls.Add("Forms.combobox.1")

With itemComboBox
.Name = "cboitem"
.Top = 20
.Left = 20
.Width = 150
.Height = 30
End With

'Add the second Combo Box for manufacturers
Set mfgComboBox = newForm.designer.Controls.Add("Forms.combobox.1")

With mfgComboBox
.Name = "cbomfg"
.Top = 60
.Left = 20
.Width = 150
.Height = 30
End With

'Add code to the newly created form
'Initialize the first combo box in the UserForm_Initialize subroutine
'Values will be taken from the first column in the spreadsheet
newForm.CodeModule.InsertLines 2, "Private Sub UserForm_Initialize()"
newForm.CodeModule.InsertLines 3, " Dim lastRow as long"
newForm.CodeModule.InsertLines 4, " Dim i as long"
newForm.CodeModule.InsertLines 5, " lastRow = Sheet1.Cells(Sheet1.Rows.Count, ""A"").End(xlUp).Row"
newForm.CodeModule.InsertLines 6, " Sheet1.Columns(""A:G"").Sort key1:=Range(""A:A""), Order1:=xlAscending, Header:=xlYes"
newForm.CodeModule.InsertLines 7, " For i = 2 To lastRow"
newForm.CodeModule.InsertLines 8, " cboitem.AddItem Sheet1.Cells(i, 1)"
newForm.CodeModule.InsertLines 9, " Next i"
newForm.CodeModule.InsertLines 10, "End Sub"

'When ever there is change in the first combo box selection, cboitem_Change will be fired
'Populate the second combo box with the manufacturers corresponding to the selected item
newForm.CodeModule.InsertLines 11, "Private Sub cboitem_Change()"
'Clear previously added manufacturers
newForm.CodeModule.InsertLines 12, " cbomfg.Clear"
newForm.CodeModule.InsertLines 13, " Dim ecol As Long, erow As Long, p As Long, q As Long"
newForm.CodeModule.InsertLines 14, " Dim cboVal As String"
newForm.CodeModule.InsertLines 15, " cboVal = cboitem.Value"
newForm.CodeModule.InsertLines 16, " lastrow = Application.WorksheetFunction.CountA(Sheet1.Range(""A:A"")) "
newForm.CodeModule.InsertLines 17, " For p = 2 To lastrow"
newForm.CodeModule.InsertLines 18, " If cboVal = Sheet1.Cells(p, 1) Then"
newForm.CodeModule.InsertLines 19, " ecol = Application.WorksheetFunction.CountA(Sheet1.Range(p & "":"" & p))"
newForm.CodeModule.InsertLines 20, " For q = 2 To ecol"
newForm.CodeModule.InsertLines 21, " cbomfg.AddItem Sheet1.Cells(p, q)"
newForm.CodeModule.InsertLines 22, " Next q"
newForm.CodeModule.InsertLines 23, " End If"
newForm.CodeModule.InsertLines 24, " Next p"
newForm.CodeModule.InsertLines 25, "End Sub"

'Add and display the newly added form
VBA.UserForms.Add(newForm.Name).Show

'Delete This Form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=newForm
End Sub

You can use the following code to create a normal user-form with two dependent dynamic combo-boxes:
Private Sub ComboBox1_Change()
Dim ecol As Long, erow As Long, p As Long, q As Long
Dim cboVal As String

UserForm1.ComboBox2.Clear
cboVal = ComboBox1.Value

erow = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))

For p = 2 To erow

If cboVal = Sheet1.Cells(p, 1) Then
ecol = Application.WorksheetFunction.CountA(Sheet1.Range(p & ":" & p))
MsgBox ecol

For q = 2 To ecol
UserForm1.ComboBox2.AddItem Sheet1.Cells(p, q)

Next q
End If

Next p

End Sub

Private Sub UserForm_Initialize()
Dim erow As Long
Dim i As Long

erow = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))

'MsgBox erow

Sheet1.Columns("A:A").Sort key1:=Range("A:A"), Order1:=xlAscending, Header:=xlYes

For i = 2 To erow
UserForm1.ComboBox1.AddItem Sheet1.Cells(i, 1)
Next i

End Sub

Details available at our website: https://www.exceltrainingvideos.com/c...