¿Como buscar en varias hojas con un dato y llenar en el Listbox?

Tengo un formulario que me busca por rango de fecha y por nombre del cliente cuando el Textbox1 cambia y realiza el filtrado. Al arrancar el formulario se cargan los datos de la hoja "clientes8". Esta macro funciona bien con una hoja pero en otras hojas también hay datos de un mismo cliente como también las mismas fechas en las que se haya realizado una operación. Lo que vengo a solicitarles es me ayuden a que pueda la macro también busque en las siguientes hojas (todas las hojas tienen la misma estructura) clientes8, clientes9, clientes10, clientes11, clientes23, clientes24, clientes25.

He intentado usar el bucle While, wend pero no logro hacerlo funcionar para el resto de hojas.

En la estructura de las hojas la fecha esta en la columna 3 y el cliente en la columna 5 y los datos a parir de la linea 3.

****************Macro carga al iniciar el formulario los datos de la hoja "clientes8" *********************
Private Sub UserForm_Initialize()
Dim fila As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set b = Sheets("clientes8")
uf = b.Range("E" & Rows.Count).End(xlUp).Row
uc = b.Cells(1, Columns.Count).End(xlToLeft).Address
wc = Mid(uc, InStr(uc, "$") + 1, InStr(2, uc, "$") - 2)
With Me.ListBox1
.ColumnCount = 7
.ColumnWidths = "50 pt;55 pt;50 pt;70 pt;120 pt;180 pt;50 pt"
.RowSource = "clientes8!A3:" & wc & uf
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

************************macro que busca por rango de fecha al cliclar el boton2 ************************

Private Sub CommandButton2_Click()
On Error Resume Next
Set b = Sheets("clientes8)
uf = b.Range("C" & Rows.Count).End(xlUp).Row
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
If dato2 = Empty Or dato1 = emtpy Then
MsgBox ("Debe ingresar datos para consulta entre rango de fechas"), vbCritical, "AVISO"
Exit Sub
End If
If dato2 < dato1 Then
MsgBox ("La fecha inicial no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
For i = 3 To uf
dato0 = CDate(b.Cells(i, 3).Value)
If dato0 >= dato1 And dato0 <= dato2 Then
Me.ListBox1.AddItem Format(b.Cells(i, 1), "#####")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Format(b.Cells(i, 4), "###,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 12)
End If
Next i
Me.ListBox1.ColumnWidths = "50 pt;55 pt;50 pt;70 pt;120 pt;200 pt;70 pt"
End Sub

***************************macro que busca cuanto el textbox1 cambia********************************

Private Sub TextBox1_Change()
On Error Resume Next
Set b = Sheets("clientes8")
uf = b.Range("E" & Rows.Count).End(xlUp).Row
If Trim(TextBox1.Value) = "" Then
'Me.ListBox1.List() = b.Range("A2:H" & uf).Value
Me.ListBox1.RowSource = "clientes8!A3:M" & uf
Exit Sub
End If

b.AutoFilterMode = False
Me.ListBox1 = Clear
Me.ListBox1.RowSource = Clear
dato1 = CDate(TextBox2)
dato2 = CDate(TextBox3)
If dato1 <> Empty Or dato2 <> Empty Then GoTo rango:
If dato2 < dato1 Then
MsgBox ("La fecha final no puede ser mayor a la fecha inicial"), vbCritical, "AVISO"
Exit Sub
End If
For i = 3 To uf
strg = b.Cells(i, 5).Value
If UCase(strg) Like UCase(TextBox1.Value) & "*" Then
Me.ListBox1.AddItem Format(b.Cells(i, 1), "#####")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Format(b.Cells(i, 4), "###,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 12)
End If
Next i

rango:

For i = 3 To uf
strg = b.Cells(i, 5).Value
dato0 = CDate(b.Cells(i, 3).Value)
If UCase(strg) Like UCase(TextBox1.Value) & "*" And dato0 >= dato1 And dato0 <= dato2 Then
Me.ListBox1.AddItem Format(b.Cells(i, 1), "#####")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 1) = b.Cells(i, 2)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 2) = b.Cells(i, 3)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 3) = Format(b.Cells(i, 4), "###,##0.00")
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 4) = b.Cells(i, 5)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 5) = b.Cells(i, 6)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 6) = b.Cells(i, 8)
Me.ListBox1.List(Me.ListBox1.ListCount - 1, 7) = b.Cells(i, 12)
End If
Next i

Me.ListBox1.ColumnWidths = "50 pt;55 pt;50 pt;70 pt;120 pt;200 pt;70 pt"
End Sub 

1 respuesta

Respuesta
3

Sustituye todo tu código por lo siguiente:

'************************macro que busca por rango de fecha al cliclar el boton2 ************************
Private Sub CommandButton2_Click()
'Act Por Dante Amor
    If TextBox2.Value = Empty Or TextBox3.Value = emtpy Then
        MsgBox ("Debe ingresar datos para consulta entre rango de fechas"), vbCritical, "AVISO"
        Exit Sub
    End If
    If TextBox3.Value < TextBox2.Value Then
        MsgBox ("La fecha inicial no puede ser mayor a la fecha final"), vbCritical, "AVISO"
        Exit Sub
    End If
    Call Cargar_Listbox
End Sub
'***************************macro que busca cuanto el textbox1 cambia********************************
Private Sub TextBox1_Change()
    Call Cargar_Listbox
End Sub
'***************************macro para Cargar el listbox
Sub Cargar_Listbox()
'Por Dante Amor
    hojas = Array("clientes8", "clientes9", "clientes10", "clientes11")
    ListBox1.Clear
    For h = LBound(hojas) To UBound(hojas)
        Set h1 = Sheets(hojas(h))
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        For i = 3 To h1.Range("C" & Rows.Count).End(xlUp).Row
            If TextBox1.Value = "" Then cliente = h1.Cells(i, "E").Value Else cliente = TextBox1.Value
            fini = h1.Cells(i, "C").Value
            ffin = h1.Cells(i, "C").Value
            If TextBox2.Value <> "" And IsDate(TextBox2.Value) And IsDate(TextBox3.Value) Then
                If CDate(TextBox2.Value) <= CDate(TextBox3.Value) Then
                    fini = CDate(TextBox2.Value)
                    ffin = CDate(TextBox3.Value)
                End If
            End If
            If UCase(h1.Cells(i, "E").Value) Like UCase(cliente) & "*" And _
               h1.Cells(i, "C").Value >= fini And _
               h1.Cells(i, "C").Value <= ffin Then
                ListBox1.AddItem Format(h1.Cells(i, "A"), "#####")
                ListBox1. List(ListBox1.ListCount - 1, 1) = h1.Cells(i, "B")
                ListBox1. List(ListBox1.ListCount - 1, 2) = h1.Cells(i, "C")
                ListBox1.List(ListBox1.ListCount - 1, 3) = Format(h1.Cells(i, "D"), "###,##0.00")
                ListBox1. List(ListBox1.ListCount - 1, 4) = h1.Cells(i, "E")
                ListBox1. List(ListBox1.ListCount - 1, 5) = h1.Cells(i, "F")
                ListBox1. List(ListBox1.ListCount - 1, 6) = h1.Cells(i, "H")
                ListBox1. List(ListBox1.ListCount - 1, 7) = h1.Cells(i, "L")
            End If
        Next
    Next
End Sub
'****************Macro carga al iniciar el formulario los datos de la hoja "clientes8" *********************
Private Sub UserForm_Initialize()
    ListBox1.ColumnCount = 7
    ListBox1.ColumnWidths = "50 pt;55 pt;50 pt;70 pt;120 pt;180 pt;50 pt"
    Call Cargar_Listbox
End Sub

No es necesario utilizar rowsource, la macro te va a cargar todas las hojas.

Solamente agrega en esta línea las hojas de búsqueda:

 Hojas = Array("clientes8", "clientes9", "clientes10", "clientes11")

Depuré todo el código para hacer solamente una carga en el listbox. Puedes filtrar por fecha o por el cliente.


'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. 
'.[Avísame cualquier duda

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas