Actualizar datos de combobox dependientes automáticamente

Encontré un código suyo sobre comboboxs dependientes pero el problema que encontré es que si agrego, edito o elimino filas de datos, en los comboboxs los datos no se actualizan al hacer click en el combobox, es decir, para que funcione tengo que ir al anterior combobox y escoger otro item y volver al item que quiero para que los valores del siguiente combobox se actualicen y en el combobox1 si agrego una nueva fila se actualizan los datos normal pero si elimino una fila siguen saliendo los datos cargados de la fila eliminada. No se si se pueda mejorar el código, este es el código:

Private Sub ComboBox1_Change()
'Por.Dante Amor
Set h2 = Sheets("Hoja2")
ComboBox2. Clear
ComboBox3. Clear
ComboBox4. Clear
ComboBox5. Clear
ComboBox6. Clear
TextBox1 = ""
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = ComboBox1 Then
agregar ComboBox2, h2.Cells(i, "B")
End If
Next
End Sub
'
Private Sub ComboBox2_Change()
'Por.Dante Amor
Set h2 = Sheets("Hoja2")
ComboBox3.Clear
ComboBox4.Clear
ComboBox5.Clear
ComboBox6.Clear
TextBox1 = ""
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = ComboBox1 And _
h2.Cells(i, "B") = ComboBox2 Then
agregar ComboBox3, h2.Cells(i, "C")
End If
Next
End Sub
'
Private Sub ComboBox3_Change()
'Por.Dante Amor
Set h2 = Sheets("Hoja2")
ComboBox4.Clear
ComboBox5.Clear
ComboBox6.Clear
TextBox1 = ""
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = ComboBox1 And _
h2.Cells(i, "B") = ComboBox2 And _
h2.Cells(i, "C") = ComboBox3 Then
agregar ComboBox4, h2.Cells(i, "D")
End If
Next
End Sub
'
Private Sub ComboBox4_Change()
'Por.Dante Amor
Set h2 = Sheets("Hoja2")
ComboBox5.Clear
ComboBox6.Clear
TextBox1 = ""
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = ComboBox1 And _
h2.Cells(i, "B") = ComboBox2 And _
h2.Cells(i, "C") = ComboBox3 And _
h2.Cells(i, "D") = ComboBox4 Then
agregar ComboBox5, h2.Cells(i, "E")
End If
Next
End Sub
'
Private Sub ComboBox5_Change()
'Por.Dante Amor
Set h2 = Sheets("Hoja2")
ComboBox6.Clear
TextBox1 = ""
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = ComboBox1 And _
h2.Cells(i, "B") = ComboBox2 And _
h2.Cells(i, "C") = ComboBox3 And _
h2.Cells(i, "D") = ComboBox4 And _
h2.Cells(i, "E") = Val(ComboBox5) Then
agregar ComboBox6, h2.Cells(i, "F")
End If
Next
End Sub
'
Private Sub ComboBox6_Change()
'Por.Dante Amor
Set h2 = Sheets("Hoja2")
TextBox1 = ""
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
If h2.Cells(i, "A") = ComboBox1 And _
h2.Cells(i, "B") = ComboBox2 And _
h2.Cells(i, "C") = ComboBox3 And _
h2.Cells(i, "D") = ComboBox4 And _
h2.Cells(i, "E") = Val(ComboBox5) And _
h2.Cells(i, "F") = Val(ComboBox6) Then
TextBox1 = h2.Cells(i, "F")
End If
Next
End Sub
'
Sub agregar(combo As ComboBox, dato As String)
'Por.Dante Amor
For i = 0 To combo.ListCount - 1
Select Case StrComp(combo.List(i), dato, vbTextCompare)
Case 0: Exit Sub 'ya existe en el combo y ya no lo agrega
Case 1: combo.AddItem dato, i: Exit Sub 'Es menor, lo agrega antes del comparado
End Select
Next
combo.AddItem dato 'Es mayor lo agrega al final
End Sub
'
Private Sub ComboBox1_DropButtonClick()
'Por.Dante Amor
Set h2 = Sheets("Hoja2")
'ComboBox1.Clear
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
agregar ComboBox1, h2.Cells(i, "A")
Next
End Sub

2 Respuestas

Respuesta

Usa un combobox en un formulario los controles ActiveX incrustados en página suelen dar errores inesperados en excel,

https://youtu.be/KCHAk9-dAPM

https://youtu.be/7c7mV8fe4sw 

https://youtu.be/T96KL_A1euo

Respuesta
1

Agrega este evento a la hoja

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A:F")) Is Nothing Then
    ComboBox1. Clear
    ComboBox2. Clear
    ComboBox3. Clear
    ComboBox4. Clear
    ComboBox5. Clear
    ComboBox6. Clear
    TextBox1 = ""
    Call ComboBox1_Change
    Call ComboBox2_Change
    Call ComboBox3_Change
    Call ComboBox4_Change
    Call ComboBox5_Change
    Call ComboBox6_Change
  End If
End Sub

¡Gracias! Dante me sirvió.

Me alegra ayudarte ¡Gracias! Por comentar.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas