Excel Dependent List Boxes In User form VBA
we have defined dynamic names for 4 columns :
- Supplier name refers to :
=OFFSET(Data!$A$2,0,0,COUNTA(Data!$A:$A)-1)
Category name refers to :
=OFFSET(Data!$B$2,0,0,COUNTA(Data!$B:$B)-1)
- Product name refers to :
=OFFSET(Data!$C$2,0,0,COUNTA(Data!$C:$C)-1)
- Price name refers to :
=OFFSET(Data!$D$2,0,0,COUNTA(Data!$D:$D)-1)
Sources code.
'For More : msexcelvba.com
Option Compare Text
Dim tablo2(), tablo3(), Category(), Supplier(), Product(), Price(), SD As Object, bul As String, c As Variant, i As Long
Private Sub ListBox1_Click()
On Error Resume Next
If ListBox1.ListIndex = -1 And IsError(Application.Match(ListBox1, Supplier, 0)) Then
Set SD = CreateObject("Scripting.Dictionary")
bul = ListBox1 & "*"
For Each c In Supplier:
If c Like bul Then SD(c) = ""
Next c
ListBox1.List = SD.keys
Else
Evn = ListBox1
If Evn = "" Then Exit Sub
Set d2 = CreateObject("Scripting.Dictionary")
For i = LBound(Category) To UBound(Category)
If Supplier(i) = Evn Then d2(Category(i)) = ""
Next i
tablo2 = d2.keys
ListBox2.Clear
ListBox3.Clear
TextBox1 = ""
ListBox2.List = tablo2
ListBox2.SetFocus
If Val(Application.Version) > 10 Then SendKeys "{f4}"
End If
i = Empty
Set d2 = Nothing
End Sub
Private Sub ListBox2_Click()
If ListBox1 <> "" Then
If ListBox2.ListIndex = -1 And IsError(Application.Match(ListBox2, Category, 0)) Then
Set SD = CreateObject("Scripting.Dictionary")
bul = UCase(ListBox) & "*"
For Each c In tablo2
If UCase(c) Like bul Then SD(c) = ""
Next c
ListBox2.List = SD.keys
Else
Set d3 = CreateObject("Scripting.Dictionary")
If ListBox1 = "" Or ListBox2 = "" Then Exit Sub
For i = LBound(Product) To UBound(Product)
If Supplier(i) = ListBox1 And Category(i) = ListBox2 Then
d3(Product(i)) = ""
End If
Next i
tablo3 = d3.keys
ListBox3.Clear
ListBox3.List = tablo3
ListBox3.SetFocus
If Val(Application.Version) > 10 Then SendKeys "{f4}"
End If
End If
i = Empty
Set d3 = Nothing
End Sub
Private Sub ListBox3_Click()
If ListBox1 <> "" And ListBox2 <> "" And ListBox3 <> "" Then
If ListBox3.ListIndex = -1 And IsError(Application.Match(ListBox3, Product, 0)) Then
Set SD = CreateObject("Scripting.Dictionary")
bul = UCase(ListBox3) & "*"
For Each c In tablo3
If c Like bul Then SD(c) = ""
Next c
ListBox3.List = SD.keys
Else
For i = LBound(Product) To UBound(Product)
If Supplier(i) = ListBox1 And Category(i) = ListBox2 And Product(i) = ListBox3 Then
TextBox1.Value = Price(i)
End If
Next i
End If
End If
i = Empty
End Sub
Private Sub UserForm_Initialize()
Dim k As Byte, x As Variant, LastRow As Long
Me.BackColor = 15658720
Me.Left = Application.Width - Me.Width - 30
Me.Top = 10
For k = 1 To 4
Controls("Frame" & k).BackColor = 15654720
Next
On Error Resume Next
LastRow = Sheets("Database").Range("A" & Sheets("Database").rows.Count).End(xlUp).Row
With Sheets("Database").Range("A2:A" & LastRow)
If WorksheetFunction.CountBlank(.Cells) > 0 Then
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
End With
Supplier = Application.Transpose(Range("Supplier"))
Category = Application.Transpose(Range("Category"))
Product = Application.Transpose(Range("Product"))
Price = Application.Transpose(Range("Price"))
Set SD = CreateObject("Scripting.Dictionary")
For Each x In Supplier
SD(x) = ""
Next x
ListBox1.List = SD.keys
End Sub
Code Explanation zoom shape.
Option Compare Text
Dim tablo2(), tablo3(), Category(), Supplier(), Product(), Price(), SD As Object, bul As String, c As Variant, i As Long