VBA Cascading Dependent Drop Down Lists does not accept values

[Armando Aldaz]

Hi all
I have downloaded the next file.

It has a userform that makes a dropdown list for each column and it filters the results (Which i belive it's very cool)

The problem comes when i perform some changes to the database, in where i put some values for the last column, as you can see in the last image

When we push the "CLEAR" button it sends me the alert "Run-time error '91': Object variable or With block variable not set.", so i think the problem/solution its to change the code in order to allows the values

So the code is the following and the debug marks the BOLD sentence

Dim con As Object
Dim rs As Object
Dim sql As String

Private Sub ComboBox1_Change()
If Not ComboBox1.Text = "" Then
Call Listbox
Call Combo(sql)
End If

End Sub

Private Sub ComboBox2_Change()
If Not ComboBox2.Text = "" Then
Call Listbox
Call Combo(sql)
End If

End Sub

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.ComboBox1.DropDown
End Sub

Private Sub ComboBox2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.ComboBox2.DropDown
End Sub
Private Sub ComboBox3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.ComboBox3.DropDown
End Sub
Private Sub ComboBox4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Me.ComboBox4.DropDown
End Sub
Private Sub ComboBox3_Change()
If Not ComboBox3.Text = "" Then
Call Listbox
Call Combo(sql)
End If
End Sub
Private Sub ComboBox4_Change()
If Not ComboBox4.Text <> "" Then
Call Listbox
Call Combo(sql)
End If
End Sub
Private Sub CommandButton1_Click()
Set con = Nothing

ComboBox1 = Empty
ComboBox2 = Empty
ComboBox3 = Empty
ComboBox4 = Empty
ListBox1.Clear
Call Userform_initialize
End Sub




Private Sub CommandButton2_Click()
Dim sat As Long, sut As Byte, s2 As Worksheet, bu As Long

If ListBox1.ListCount = 0 Then
MsgBox "There Aren't Data", vbExclamation
Exit Sub
End If
Sheets("FilteredData").Activate
Sheets("FilteredData").Range("A:D").Clear
Set s2 = Sheets("FilteredData")
sat = ListBox1.ListCount
sut = ListBox1.ColumnCount
bu = s2.Range("A" & Rows.Count).End(xlUp).Row + 1

s2.Range("A" & bu & ":D" & sat + bu - 1) = ListBox1.List
MsgBox "The Data Was Copied."
Set s2 = Nothing
End Sub

'*****
Private Sub Userform_initialize()
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

Call Combo("")
End Sub
'*****

Sub Listbox()
sql = "select * from [Data$A2:D1000] Where F1 is not null"
If ComboBox1.Text <> "" Then sql = sql & " and f1 = '" & ComboBox1.Value & "'"
If ComboBox2.Text <> "" Then sql = sql & " and f2 = '" & ComboBox2.Value & "'"
If ComboBox3.Text <> "" Then sql = sql & " and f3 = '" & ComboBox3.Value & "'"
If ComboBox4.Text <> "" Then sql = sql & " and f4 = '" & ComboBox4.Value & "'"
Set rs = con.Execute(sql) '(Here is the problem)
ListBox1.ColumnCount = rs.Fields.Count
ListBox1.Column = rs.GetRows(rs.RecordCount)

End Sub

Sub Combo(ByVal Tablo As String)
If Tablo = "" Then Tablo = "[Data$A:D]"
ComboBox1.Column = con.Execute("select distinct F1 from (" & Tablo & ")").GetRows
ComboBox2.Column = con.Execute("select distinct F2 from (" & Tablo & ")").GetRows
ComboBox3.Column = con.Execute("select distinct F3 from (" & Tablo & ")").GetRows
ComboBox4.Column = con.Execute("select distinct F4 from (" & Tablo & ")").GetRows
End Sub

Hope all of you can help me.
Thanks in advance!

A.ALDAZ