Excel VBA Dependent (Cascaded) Filtering With ADO

            Excel Dependent Drop Down Lists


The columns (based on column B,C,D) can be filtered quickly  with dependent  List Boxes on the Excel userform .


The userform contains 3 text boxes and 3 list boxes.
When any textbox is clicked ,the userform extends downwards later listbox that associated to textbox appears . 

       Data in the column are listed as unique values and are sorted ordering on listbox control . Column B is listed on Listbox1, column C is listed on Listbox2, column D is listed on Listbox3.
For example, we use the following codes to list the data in column B into the Listbox1 as unique values and sort ordering :
Dim a As Variant, hcr As Range, i As Long, j As Long, x As Variant
ListBox1.Clear
With CreateObject("Scripting.Dictionary")
    For Each hcr In Sheets("Main").Range("B3:B" & Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlCellTypeVisible)
        If Not .exists(hcr.Value) Then
            .Add hcr.Value, Nothing
        End If
    Next hcr
a = .keys
End With
For i = LBound(a) To UBound(a) - 1
    For j = i + 1 To UBound(a)
        If StrComp(a(i), a(j)) = 1 Then
            x = a(j)
            a(j) = a(i)
            a(i) = x
        End If
    Next j
Next i
On Error Resume Next
ListBox1.List = a


With text boxes,any value can be searched  within the listbox through Ado Connection ⤵️

excel dependent list boxes

Codes to filter in Listbox1 :
 Dim s As String, con As Object
    Me.ListBox1.Clear
    DoEvents
 
Application.ScreenUpdating = False

    Set con = CreateObject("adodb.connection")
    #If VBA7 And Win64 Then
    con.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No;"""
   #Else
    con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;HDR=No;"""
    #End If
 
    s = "select distinct f2 from [Main$A3:D" & Range("D" & Rows.Count).End(xlUp).Row & "]  where not isnull(f2)"
    If TextBox1.Text <> "" Then s = s & " and f2 like '" & VBA.UCase(LCase(TextBox1.Text)) & "%'"
     
On Error GoTo hata
    ListBox1.Column = con.Execute(s).getrows
Application.ScreenUpdating = True
...

In addition, the filtering is done with "AutoFilter" method within the worksheet.

Filtering results can be copied to other sheet.
excel dependent listbox


No comments:

Post a Comment