Excel VBA ListBox carga datos por fecha pero se requiere agregar una nueva condición a través de ComboBox
De verdad espero me puedan ayudar. Tengo una macro que funciona a la perfección cargando datos a un ListBox en un Userform a través de una fecha incial y una fecha final, el problema se me presenta porque requiero que ya no solo cargue por la fecha, sino también que cargue por el dato seleccionado en un ComboBox. Los datos se encuentran en la columna AB y no necesito que se muestren en el ListBox ni se copien a la otra hoja "TEMPORAL", solo que cuando se coloque las fechas y se seleccione el dato del ComboBox traiga al ListBox la información de las filas que estén en el rango de fechas y que cumpla con dato del Combobox . Aquí adjunto la macro que ya tengo que funciona perfectamente pero no consigo me coloque solo los que tengan el dato del Combobox, solo me trae todo lo que hay en las fechas establecidas.
Private Sub ACEPTAR_Click()
Application.ScreenUpdating = False
Set h1 = Sheets("BASE DE DATOS FACTURACION")
h1.Unprotect ("2024")
If h1.FilterMode Then h1.ShowAllData
Set h2 = Sheets("TEMPORAL")
col = "A" 'columna de Fechas
Fila = 5 'fila de encabezados
uc = Columns("AB").Column 'última columna con datos
ucm = Columns("W"). Column 'última columna con datos a mostrar en listbox
h2. Cells. Clear
ListBox1.RowSource = ""
If TextBox1.Value = "" Or Not IsDate(TextBox1.Value) Then
MsgBox "CAPTURA UNA FECHA DE INICIO"
TextBox1.SetFocus
Exit Sub
End If
If Me.TextBox2.Value = "" Or Not IsDate(TextBox2.Value) Then
MsgBox "CAPTURA UNA FECHA DE FINAL"
TextBox2.SetFocus
Exit Sub
End If
fec1 = CDate(TextBox1.Value)
fec2 = CDate(TextBox2.Value)
If fec2 < fec1 Then
MsgBox "¡LA FECHA FINAL NO PUEDE SER MENOR A LA FECHA DE INICIO!"
TextBox2.SetFocus
Exit Sub
End If
If ComboBox1.Value = "" Then
MsgBox "DEBE SELECCIONAR UNA EMPRESA"
ComboBox1.SetFocus
Exit Sub
End If
Application.ScreenUpdating = False
If h1.AutoFilterMode Then h1.AutoFilterMode = False
U1 = h1.Range("A" & Rows.Count).End(xlUp).Row
coln = Columns(col).Column
h1.Range(h1.Cells(Fila, "A"), h1.Cells(U1, uc)).AutoFilter Field:=coln, _
Criteria1:=">=" & Format(fec1, "mm/dd/yyyy"), Operator:=xlAnd, _
Criteria2:="<=" & Format(fec2, "mm/dd/yyyy")
U1 = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range(h1.Cells(Fila, "A"), h1.Cells(U1, uc)).Copy h2.Cells(1, "A")
U2 = h2.Range("A" & Rows.Count).End(xlUp).Row
If U2 = 1 Then
MsgBox "¡NO EXISTEN REGISTROS CON ESE FILTRO!", vbExclamation, "FILTRO"
Else
rango = Range(Cells(2, "A"), Cells(U2, ucm)).Address
h2.Cells.EntireColumn.AutoFit
ancho = ""
For i = 1 To ucm
ancho = ancho & Int(h2.Cells(1, i).Width) + 3 & ";"
Next
ListBox1.RowSource = h2.Name & "!" & rango
ListBox1.ColumnCount = ucm
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = ancho
End If
For X = 0 To ListBox1.ListCount - 1
If ListBox1.List(X, 0) <> "" Then
m = m + 1
End If
Next
TextBox3.Value = m
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h1.Range("A5:AB5").AutoFilter
h1.Protect ("2024"), AllowFiltering:=True
End Sub