VBA Listas dependientes con Combo Boxes no acepta valores

[Armando Aldaz]

Hola a todos!
He descargado el siguiente archivo, el cual contiene un listado de articulos.

El archivo contiene un Userform el cual despliega una lista dependiente en cuanto el puntero es ubicado en cada una de las casillas (Muy útil)

El problema resulta cuando dicha tabla o información de orginen es reemplazada, como en este caso por el ejemplo de partidas presupuestarias, en la que al colocar un valor numerico, como se puede apreciar en la imagen en la columa D "Amount"

En cuanto se da click al boton "Clear" (Command Button 1) envia la siguiente alerta "Run-time error '91': Object variable or With block variable not set.", esto al detectar que es un valor numerico.

El codigo de VBA esta estructurado de la siguiente manera, y en Negritas marcare donde se encuentra el error o debug.


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) '(Aqui esta el problema)
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

Espero puedan apoyarme con esta consulta.
Gracias de antemano!

A.ALDAZ

 

[Fluff]

Duplicate to: VBA Cascading Dependent Drop Down Lists does not accept values

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, I have closed this thread so please continue in the linked thread. If you do not receive a response, you can "bump" it by replying to it yourself, though we advise you to wait 24 hours before doing so, and not to bump a thread more than once a day.