Buscar factura desde un listado de facturas (excel)

Va la macro

Sub Buscar_factura()
'   Por Dante Amor
    '
    Set h1 = Sheets("factura")
    Set h2 = Sheets("compras_listas")
    '
    factura = h1.Range("K8").Value
    If factura = "" Then
        MsgBox "Falta el número de la factura"
    End If
    '
    fila = 25
    h1.Range("F25:L68").ClearContents
    Set r = h2.Columns("J")
    Set b = r.Find(factura, LookAt:=xlWhole)
    If Not b Is Nothing Then
        celda = b.Address
        Do
            j = b.Row
            h1.Range("K17").Value = h2.Cells(j, "F").Value      'fecha
            h1.Range("K18").Value = h2.Cells(j, "G").Value      'cod prov
            h1.Range("K19").Value = h2.Cells(j, "H").Value      'prov
            h1.Range("K20").Value = h2.Cells(j, "I").Value      'tipo
            h1.Range("K21").Value = h2.Cells(j, "J").Value      'num
            h1.Range("K22").Value = h2.Cells(j, "K").Value      'forma
            h1.Cells(fila, "F").Value = h2.Cells(j, "L").Value  'nomb
            h1.Cells(fila, "G").Value = h2.Cells(j, "M").Value  'cod
            h1.Cells(fila, "H").Value = h2.Cells(j, "N").Value  'precio
            h1.Cells(fila, "I").Value = h2.Cells(j, "O").Value  'cant
            h1.Cells(fila, "J").Value = h2.Cells(j, "P").Value  'importe
            h1.Cells(fila, "K").Value = h2.Cells(j, "Q").Value  'dto
            h1.Cells(fila, "L").Value = h2.Cells(j, "R").Value  'subtot
            h1.Range("L69").Value = h2.Cells(j, "S").Value      'total
            fila = fila + 1
            Set b = r.FindNext(b)
        Loop While Not b Is Nothing And b.Address <> celda
    Else
        MsgBox "No existe ese número de Factura"
    End If
End Sub

[Sal u dos

¡Gracias!

Funciona, pero...

Coloque esa macro en un botón en mi hoja de factura, pero al ejecutar la macro, me borra todas las fórmulas del rango y no puedo o añadir y/o quitar artículos a esa factura buscada o crear una nueva factura.

Doy por entendido que tendría que copiar mi hoja factura para poder hacer mi búsqueda.

Pero, cabria la opción de no tener que hacerla, ¿y así poder modificar la factura en caso necesario o hacer una nueva?

Al enviar los datos a mi hoja de compras_lista, excel va muy lento.

Creo que sera porque, a su vez, mi hoja artículos tiene en un rango de 20000 filas la fórmula sumar.si, para hacer un total de stock tanto de entradas y salidas.

¿Puede ser por eso? ¿Tiene solución?

Quita la instrucción clearcontents de la macro para que no te borre las fórmulas.

Es lento por las fórmulas.

¡Gracias!

¿Y habría alguna forma de hacer el recuento de stock sin que excel se me bloquee por algunos miniutos?

Porque excel se tira como 2-3 minutos pensando y se bloquea.

Haber si te sirve esta macro

Sub Busqueda_Con_ConsultaV()
'
'   Aplica para el rango "F25:L25"
'
    Application.ScreenUpdating = False
    Set Rng = Range("F25")
    Rng.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;3;FALSO)"
    Rng.Offset(0, 1).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;4;FALSO)"
    Rng.Offset(0, 2).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;5;FALSO)"
    Rng.Offset(0, 3).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;6;FALSO)"
    Rng.Offset(0, 4).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;7;FALSO)"
    Rng.Offset(0, 5).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;8;FALSO)"
    Rng.Offset(0, 6).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;9;FALSO)"
    Range("K7").Select
    Application.ScreenUpdating = True
End Sub
Sub LIMPIA()
'
' Limpia rango "F25:L25"
'
Range("F25:L25").ClearContents
Range("K7").Select
End Sub
Sub Copiadodefactura()
'
' Esta macro es para que no des click por equivocacion en agregar y vuelvas a copiar los datos dela busqueda en tu registro (COMPRA_LISTA)
'
Set Rng = Range("F25")
If Range("F25") <> "" Then
    If Rng.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J:$R;3;FALSO)" Then
    MsgBox "No puedes copiar un resultado de busqueda, el valor ya existe en la COMPRAS_LISTA", vbCritical, "ERROR AL INGRESAR DATOS"
        Else
        ' Aqui va tu codigo de copiado
    End If
End If
End Sub

La macro "Cosulta_Con_ConsultaV" es para agregar en tu linea de factura rango("f25:L25") para que se consulte desde tu celda "K7"

La macro "Limpiar"

Es para que te limpie el rango("F25:L25")

Y la ultima macro "Copiadodefacturas" seria para combinar con tu macro de copiado para que no ingreses por error en tu registro una busqueda previa...

'

Espero sea esto lo que buscas =)

Me olvidaba.. yo uso Office 2010, si tu usas una version más reciente quizás tengas que verificar si tienes la función "ConsultaV" o "BuscarV" en caso de ser la segunda tendrás que cambiarlo en cada línea que aparezca "ConsultaV" por "BuscarV"

¡Gracias!

Muchas gracias por la macro.

Funciona a medias. Tan solo trae el primer resultado con el numero de factura introducido.

No trae los demás items ni los demás datos de factura (prov, código prov. forma de pago), tan solo el primer resultado.

Alguna sugerencia

¿Tu querías que ingresando un número te muestre todas las facturas? Pensé que querías que te muestre solamente la factura con ese código

Entonces o te sirve porque así sólo te agrega un buscar en la primera línea

Donde dice

Set Rng = Range("F25")

Cambiarlo por  las filas que quieres que se aplique la búsqueda 

Ejemplo

Set Rng = Range("F25:F60")

Prueba cambiar esa línea haber si te funciona 

Sino te funciona me avisas y mañana cuando llegue a la oficina revisó la macro porque no tengo un equipo en este momento para chequearla

Buenos días fjpg81 la macro de arriba solo te buscaba la primer fila de tu listado, no sabia que llevaban todas las facturas el mismo código... ahora si te la corregí para que busque en la primer línea y luego te desplace la búsqueda hasta la fila 60

Sub Busqueda_Con_ConsultaV()
'
'
    Application.ScreenUpdating = False
    Set Rng = Range("F25")
    Rng.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;3;FALSO)"
    Rng.Offset(0, 1).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;4;FALSO)"
    Rng.Offset(0, 2).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;5;FALSO)"
    Rng.Offset(0, 3).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;6;FALSO)"
    Rng.Offset(0, 4).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;7;FALSO)"
    Rng.Offset(0, 5).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;8;FALSO)"
    Rng.Offset(0, 6).Select
    Selection.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;9;FALSO)"
    'Esta parte es la que desplaza la busqueda hasta la fila 60
    Range("F25:L25").Select
    Selection.AutoFill Destination:=Range("F25:L60"), Type:=xlFillDefault
    Range("K7").Select
    Application.ScreenUpdating = True
End Sub
Sub LIMPIA()
'
' Limpia rango "F25:L60"
'
Range("F25:L60").ClearContents
Range("K7").Select
End Sub
Sub Copiadodefactura()
'
' Esta macro es para que no des click por equivocacion en agregar y vuelvas a copiar los datos dela busqueda en tu registro (COMPRA_LISTA)
'
Set Rng = Range("F25")
If Range("F25") <> "" Then
    If Rng.FormulaLocal = "=CONSULTAV($K$7;COMPRAS_LISTA!$J13:$R13;3;FALSO)" Then
    MsgBox "No puedes copiar un resultado de busqueda, el valor ya existe en la COMPRAS_LISTA", vbCritical, "ERROR AL INGRESAR DATOS"
        Else
        ' Aqui va tu codigo de copiado
    End If
End If
End Sub

¡Gracias! Probé la macro de dante y funciona con un pero, ya le hice la pregunta acerca de la duda.

Muchas gracias Sebastián!