Macro VBA Excel para buscar en 3 hojas según condición

Esta macro

Private Sub cmbBusque_Click()
'Por.Dante Amor
    'Filtrar por fecha
    Dim U As Double, i As Double
    Dim h1 As Object, h2 As Object
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set h1 = Sheets("Productos")
    Set h2 = Sheets("Filtro")
    h2.Cells.Clear
    '
    If DTPicker1 > DTPicker2 Then
        MsgBox "La fecha inicial no puede ser superior a la final", vbExclamation, "REVISAR FECHAS"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    U = h1.Range("E" & Rows.Count).End(xlUp).Row
    h1.Range("A1:g" & U).AutoFilter
    h1.Range("A1:g" & U).AutoFilter Field:=5, Criteria1:=">=" & Format(DTPicker1, "mm/dd/yyyy"), _
                             Operator:=xlAnd, Criteria2:="<=" & Format(DTPicker2, "mm/dd/yyyy")
    If h1.Range("E" & Rows.Count).End(xlUp).Row = 1 Then
        MsgBox "No existen registros", vbExclamation, "REVISAR FECHAS"
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    h1.Range("A1:g" & U).Copy h2.[A1]
    ListBox1.RowSource = h2.Name & "!A2:g" & h2.Range("g" & Rows.Count).End(xlUp).Row
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
''' Cuenta y muestra cantidad de items en el ListBox
    txtExistencia.Text = ListBox1.ListCount
'''
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

ejecuta una busqueda(filtra) entre fechas dentro de una hoja (Productos); Fecha inicial y fecha final.

Como se ve en el formulario, le agregue 3 OptionBotton con nombre de hoja respectiva

Se agradece la buena voluntad en darme esa mano de ayuda, en editar la macro para que me busque en la hoja según la condición true del OptionBotton.

Respuesta
1

[Hola

Prueba con esto

Valora la respuesta para finalizar saludos!

Private Sub cmbBusque_Click()
'Por.Dante Amor
'Act. Adriel
    'Filtrar por fecha
    Dim U As Double, i As Double
    Dim h1 As Object, h2 As Object
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
    If OptionButton1 Then
        Set h1 = Sheets("Productos")
    ElseIf OptionButton2 Then
        Set h1 = Sheets("Entrada")
    ElseIf OptionButton3 Then
        Set h1 = Sheets("Salida")
    End If
    '
    Set h2 = Sheets("Filtro")
    h2.Cells.Clear
    '
    If DTPicker1 > DTPicker2 Then
        MsgBox "La fecha inicial no puede ser superior a la final", vbExclamation, "REVISAR FECHAS"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    U = h1.Range("E" & Rows.Count).End(xlUp).Row
    h1.Range("A1:g" & U).AutoFilter
    h1.Range("A1:g" & U).AutoFilter Field:=5, Criteria1:=">=" & Format(DTPicker1, "mm/dd/yyyy"), _
                             Operator:=xlAnd, Criteria2:="<=" & Format(DTPicker2, "mm/dd/yyyy")
    If h1.Range("E" & Rows.Count).End(xlUp).Row = 1 Then
        MsgBox "No existen registros", vbExclamation, "REVISAR FECHAS"
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    h1.Range("A1:g" & U).Copy h2.[A1]
    ListBox1.RowSource = h2.Name & "!A2:g" & h2.Range("g" & Rows.Count).End(xlUp).Row
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
''' Cuenta y muestra cantidad de items en el ListBox
    txtExistencia.Text = ListBox1.ListCount
'''
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Hola Adriel Ortiz

La modificcion, funciona solo con el Option de Productos pero si activo el de Entrada o de Salida, me dice que "No hay Registros" y dentro de la hoja, si los hay

Tiene en cuenta que en los DTPicker coloco las fechas necesarias y correctas para que me muestre las fechas desde la inicial hasta la final en el ListBox

Envíame tu archivo para revisarlo saludos! [email protected] 

En la hoja Producto la fecha está en la columna " E" y en entrada y salida está en la "D".

En conclusión todas las hojas la fecha debe estar en la columna E

Hola Adriel

Tienes toda la razón, cosa que no me había pasado por la mente.

Ayúdame a solucionar este punto porque como ves, la Entrada y la Salida son menos columnas, ahí no hace falta la Ubicación ni el precio. Aquí como desconocedor de macros, en mi ignorante conocimiento, seria ¿ocultar la columna DE y pasar la macro respectiva de insertar en DE seria insertar en E?Seria en la macro de Validación, después de la DE oculta, avanzar una letra

    'registro de entrada / salida en su hoja respectiva
    codigo = lista2.List(lista2.ListIndex, 0)
    U = h.Range("A" & Rows.Count).End(xlUp).Row + 1
    h.Cells(U, "A") = codigo
    h.Cells(U, "B") = lista2.List(lista2.ListIndex, 1)
    h.Cells(U, "C") = wcantidad
    h.Cells(U, "D") = DTPicker1.Value 'PASAR A E
    h.Cells(U, "E") = lista2.List(lista2.ListIndex, 6) 'PASAR A F

¿Será correcto?

Si, pero otro dilema me aparece. En las 3 hojas los datos comienzan en línea 2.

Al buscar las fechas me muestra de hoja Productos, en el listbox me muestra los títulos más los datos encontrados y en las hojas Entrada y Salida me muestra títulos (Col8umna A, Columna B, Columna C etc y siguen los títulos más los datos, ¿siendo la misma macro CON EL MISMO BUTTON?

[Hola 

La información no es precisa por que las hojas tienen diferentes cantidades de encabezado.

Entonces lo harías por separado

Así

Private Sub CommandButton1_Click()
'Por.Dante Amor
'Act. Adriel
    'Filtrar por fecha
    Dim u As Double, i As Double
    Dim h1 As Object, h2 As Object, h3, h4 As Object
    '
    'Primer option PRODUCTOS
    If OptionButton1 Then
    '
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '
        Set h1 = Sheets("Productos")
        Set h2 = Sheets("Filtro")
        h2.Cells.Clear
    '
    If DTPicker1 > DTPicker2 Then
        MsgBox "La fecha inicial no puede ser superior a la final", vbExclamation, "REVISAR FECHAS"
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
    u = h1.Range("E" & Rows.Count).End(xlUp).Row
    h1.Range("A1:g" & u).AutoFilter
    h1.Range("A1:g" & u).AutoFilter Field:=5, Criteria1:=">=" & Format(TextBox1, "mm/dd/yyyy"), _
                             Operator:=xlAnd, Criteria2:="<=" & Format(TextBox2, "mm/dd/yyyy")
    If h1.Range("E" & Rows.Count).End(xlUp).Row = 1 Then
        MsgBox "No existen registros", vbExclamation, "REVISAR FECHAS"
        If h1.AutoFilterMode Then h1.AutoFilterMode = False
        Application.ScreenUpdating = True
        Exit Sub
    End If
    '
    h1.Range("A1:g" & u).Copy h2.[A1]
    ListBox1.RowSource = h2.Name & "!A2:g" & h2.Range("g" & Rows.Count).End(xlUp).Row
    If h1.AutoFilterMode Then h1.AutoFilterMode = False
''' Cuenta y muestra cantidad de items en el ListBox
    'txtExistencia.Text = ListBox1.ListCount
'''
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End If
    ' option ENTRADA
        If OptionButton2 Then
        '
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    '
            Set h3 = Sheets("Entrada")
            Set h2 = Sheets("Filtro")
            h2.Cells.Clear
        '
        If DTPicker1 > DTPicker2 Then
            MsgBox "La fecha inicial no puede ser superior a la final", vbExclamation, "REVISAR FECHAS"
            Application.ScreenUpdating = True
            Exit Sub
        End If
        '
        If h3.AutoFilterMode Then h3.AutoFilterMode = False
        u = h3.Range("E" & Rows.Count).End(xlUp).Row
        h3.Range("A1:E" & u).AutoFilter
        h3.Range("A1:E" & u).AutoFilter Field:=5, Criteria1:=">=" & Format(TextBox1, "mm/dd/yyyy"), _
                                 Operator:=xlAnd, Criteria2:="<=" & Format(TextBox2, "mm/dd/yyyy")
        If h3.Range("E" & Rows.Count).End(xlUp).Row = 1 Then
            MsgBox "No existen registros", vbExclamation, "REVISAR FECHAS"
            If h3.AutoFilterMode Then h3.AutoFilterMode = False
            Application.ScreenUpdating = True
            Exit Sub
        End If
        '
        h3.Range("A1:E" & u).Copy h2.[A1]
        ListBox1.RowSource = h2.Name & "!A2:E" & h2.Range("E" & Rows.Count).End(xlUp).Row
        If h3.AutoFilterMode Then h3.AutoFilterMode = False
    ''' Cuenta y muestra cantidad de items en el ListBox
        'txtExistencia.Text = ListBox1.ListCount
    '''
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        End If
   ' option SALIDA
        If OptionButton3 Then
        '
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
    '
            Set h4 = Sheets("Salida")
            Set h2 = Sheets("Filtro")
            h2.Cells.Clear
        '
        If DTPicker1 > DTPicker2 Then
            MsgBox "La fecha inicial no puede ser superior a la final", vbExclamation, "REVISAR FECHAS"
            Application.ScreenUpdating = True
            Exit Sub
        End If
        '
        If h4.AutoFilterMode Then h4.AutoFilterMode = False
        u = h4.Range("E" & Rows.Count).End(xlUp).Row
        h4.Range("A1:E" & u).AutoFilter
        h4.Range("A1:E" & u).AutoFilter Field:=5, Criteria1:=">=" & Format(TextBox1, "mm/dd/yyyy"), _
                                 Operator:=xlAnd, Criteria2:="<=" & Format(TextBox2, "mm/dd/yyyy")
        If h4.Range("E" & Rows.Count).End(xlUp).Row = 1 Then
            MsgBox "No existen registros", vbExclamation, "REVISAR FECHAS"
            If h4.AutoFilterMode Then h4.AutoFilterMode = False
            Application.ScreenUpdating = True
            Exit Sub
        End If
        '
        h4.Range("A1:E" & u).Copy h2.[A1]
        ListBox1.RowSource = h2.Name & "!A2:E" & h2.Range("E" & Rows.Count).End(xlUp).Row
        If h4.AutoFilterMode Then h4.AutoFilterMode = False
    ''' Cuenta y muestra cantidad de items en el ListBox
        'txtExistencia.Text = ListBox1.ListCount
    '''
        Application.ScreenUpdating = True
        Application.DisplayAlerts = True
        End If
End Sub

Hice la prueba con textbox ya lo actualizas a DTPicker

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Crear base de datos en excel

Como puedo crear una base de datos con Excel, que puedas introducir nombre, teléfono, tinte y registrar, buscar y eliminar
2 respuestas

Ocultar contraseña en macro

Tengo un archivo al cual le inserte una macro de apertura, que al abrir me pide contraseña, pero al digitarla muestra la contraseña, ¿Cómo hago para ocultarla? ¿Cómo hago para que al abrir esta me abra en una hoja especifica?
2 respuestas

Ejecutar macro si en la celda B1 hay datos

Esta es la macro que utilizo siempre, pero tengo la dificultad que a veces me olvido de colocar el numero de curso (Ejp. 1era_1era o 2da_2da ...)en la celda B1, todo este proceso se ejecuta en la hoja Activa "Curso", lo que busco que la macro se...
2 respuestas

¿Qué hay de mal en este macro?

Quiero hacer un macro para hacer un filtro de una base de datos poniendo como condición un periodo de tiempo, teniendo una celda como fecha de inicio y otra celda como fecha de terminación. Te mando imagen de mi libro y código. Muchas gracias Sub...
1 respuesta

Dividir un valor en excel y que el resultado sea igual al de una calculadora manual

Sres. T.E La Consulta es la siguiente: Como dividir 4.888,00 / 30 y que el resultado sea igual tanto en excel como una calculadora manual o la calculado de win xp. Ejemplos: En excel 2003 si divido 4.888,00 / 30 = 162,93 En una Calculadora 4.888,00 /...
2 respuestas

No puedo registrar más de 30k renglones, sale error de desbordamiento (Error 6)

Tengo el siguiente código, que de un formulario pasa los datos a una tabla. El problema es que después de aprox. 35,000 renglones registrados, al querer seguir registrando me aparece el error de desbordamiento (Error 6). Comparto código, si de favor...
3 respuestas

Optimizar macro para combinar filas

Tengo una macro que acumula valores de filas determinados según columnas similares, funciona bien con una tabla de datos intermedia en cuanto a su tiempo de ejecución, lo que quiero es optimizar esta macro o mejorarla ya que tengo tablas de hasta...
3 respuestas

Ordenar listado en excel por numero de tienda

Tengo un listado de productos en excel y en la misma celda viene el numero de la tienda y los totales de cada tienda, pero si tengo más de 100 tiendas quiero agregar una columna donde me diga que tienda es y así poder ordenar mi listado por el número...
1 respuesta

Hacer un nuevo archivo copiando la hoja2 y hoja3 de una lista de nombres que están en la hoja1.

En la hoja1 tengo una lista de nombres y quiero copiar la hoja=evaluación y hoja=metas a un nuevo libro con el nombre de la lista de la hoja1 las dos hojas en el mismo nuevo libro.
1 respuesta

Tengo una macro , que necesita que de una lista de alumnos

Imprime un informe de un alumno en particular, necesito que el usuario digite un numero y luego siga con los pasos siguientes, es decir que imprima el usuario seleccionado . ¿Cómo puedo pausar una macro?
2 respuestas