Buenas tardes foro, mi consulta es la siguiente:tengo un archivo con tres pestañas y la macro funciona bien  con pocos registros, el detalle es que en una de las hojas con la que se alimenta el reporte,  tiene mas de 5000 registros y no funciona únicamente jala la información de dos columnas del reporte, si elimino registros y dejo pocos, funciona perfectamente.

Me gustaría saber si tengo algo mal en la macro o estoy limitando el rango, se que para mejor ayuda debo subir un archivo, pero voy a intentar subir el archivo nuevamente, porque ya le elimine registros  y hojas solo deje unos registros como prueba pero aun así no me permite subirlo, dejo la macro e intentare subirlo, mucho agradecer su ayuda. saludos y buen día.

Sub Reporte()
Dim Instrum, Estatus As String
Dim Hoy
Dim cont, Fila As Integer

    
    'On Error Resume Next
    Range("a4:G800").Select
    Selection.ClearContents
    Range("a1").Select
    Hoy = Now
    cont = 3
    For j = 2 To 8000
        If Hoja3.Cells(j, 1) = "" Then Exit For 'numero de serie
        If Hoja3.Cells(j, 4) = "" Then GoTo 150  'Descripcion
         If Hoja3.Cells(j, 5) = "" Then GoTo 150  'Marca
          If Hoja3.Cells(j, 1) = "" Then GoTo 150  'Codigo
        If Hoja3.Cells(j, 23) = "SI" Then GoTo 150  'baja si o no
         If Hoja3.Cells(j, 21) = "" Then GoTo 150  'Responsable
        Instrum = Hoja3.Cells(j, 6).Text 'Datos Instrumentos, Instrumento
        Estatus = "VIGENTE"
        With Worksheets("Datos calibración").Range("a1:a8000") 'hoja4
            Set c = .Find(Instrum, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    Fila = c.Row
                    If UCase(Left(Hoja4.Cells(Fila, 16).Text, 11)) = "NUEVO CICLO" Then GoTo 100
                    If Left(Hoja4.Cells(Fila, 16).Text, 15) = "BAJA DEFINITIVA" Then GoTo 150 'observaciones
                    If Hoja4.Cells(Fila, 15) < Hoy Then
                        Estatus = "VENCIDO"
                    Else
                        Estatus = "VIGENTE"
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
        If Estatus = "VENCIDO" Then
100
            cont = cont + 1
            Hoja8.Cells(cont, 1) = Hoja3.Cells(Fila, 6)
            Hoja8.Cells(cont, 2) = Hoja3.Cells(Fila, 4)
            Hoja8.Cells(cont, 3) = Hoja3.Cells(Fila, 5)
            
            Hoja8.Cells(cont, 4) = Hoja4.Cells(Fila, 12)
            Hoja8.Cells(cont, 5) = Hoja4.Cells(Fila, 15)
            Hoja8.Cells(cont, 6) = Hoja3.Cells(Fila, 21)
            
            If Hoja4.Cells(Fila, 16) <> "" Then
                If Hoja4.Cells(Fila, 15) = "" Then
                    Hoja8.Cells(cont, 2) = Hoja4.Cells(Fila, 16)
                End If
            End If
            If UCase(Left(Hoja4.Cells(Fila, 16).Text, 11)) = "NUEVO CICLO" Then
                Hoja8.Cells(cont, 2) = UCase(Hoja4.Cells(Fila, 16).Text)
            End If
        End If
            
150
    Next j

    
End Sub

Private Sub CommandButton1_Click()

End Sub

Private Sub cmbRepovenc_Click()
    Reporte
End Sub

 

Bueno subí mi archivo, lo convertí a Binario y le elimine un so many de filas y por fin pude.

Rep.xlsb

Hola declara estas dos variables como long

Dim cont as long, Fila As long

Hace 1 hora, asalinasc dijo:

Bueno subí mi archivo, lo convertí a Binario y le elimine un so many de filas y por fin pude.

Rep.xlsb

Hola @LeandroA upload el archivo again y si efectivamente funciona, pero lo raro es que de las 5600 que tengo le fui borrando de 1000 en 1000 y únicamente hasta 600 registros busca,de la Hoja4 (Datos de Calibración).

ahora si no se si en la macro esta predeterminado algún rango de filas.

Gracias por tu ayuda, a ver si por ahí salta el detalle.

Rep - copia.xlsb

No entiendo, le añadi registros a tu informacion casi 9000, corri tu macro y no me dio ningun problema, solo veo dos cosas:

1.- tienes numero de serie repetidos que al no ser valores unicos pueden dar confundir al programa y darte informacion de uno por otro: por ejemplo.

STARRETT	CA-13
MITUTOYO	CA-13

2.- la macro esta hecha de forma muy basica, los valores del rango son fijos: Range("a4:G6000"), Range("a1:a5000"), si quitas informacion haces trabajar a la macro inecesariamente o si agregas registros arriba del limite la macro los dejara fuera.

en tu caso dices que tienes 5600 registros, si te fijas el ciclo for j=2 to 5000, solo procesa 5000 y te deja 600 registros fuera, otra cosa la hoja de calibraciones es la que marca la pauta si hay 20 registros en esa hoja solo buscara esos 20 entre los 5600 y de esos 20 solo te dejara aquellos que se ajusten a las condiciones establecidas.

Lo que te aconsejo es cambiar la programacion de tipo estatico a una de tipo dinamico asi si quitas o agregas informacion no afectara a la hora de que la macro procese la info.

por lo pronto ajusta el ciclo for a J=2 to 9000 o a 5600 y corre de nuevo la macro.

 

 

@Dr Hyde hola,  con respecto a tu comentario agradezco el analisis de la macro, aunque todavia no logro que run la macro y que funcione con mas registros, tengo Excel 2016 y Excel 2013, en plataforma Win10, A 64Bs, realmente no entiendo que pasa, le agregue la tabla original (5600 registros) y aplique los cambios que comentabas y nada  esta es la macro que uso con los cambios:

Sub Reporte()
Dim Instrum, Estatus As String
Dim Hoy
Dim cont As Long, Fila As Long
 
    'On Error Resume Next
    Range("a4:g9000").Select
    Selection.ClearContents
    Range("a1").Select
    Hoy = Now
    cont = 3
    For j = 2 To 9000
        If Hoja3.Cells(j, 1) = "" Then Exit For 'numero de serie
        If Hoja3.Cells(j, 4) = "" Then GoTo 150  'Descripcion
         If Hoja3.Cells(j, 5) = "" Then GoTo 150  'Marca
          If Hoja3.Cells(j, 1) = "" Then GoTo 150  'Codigo
        If Hoja3.Cells(j, 23) = "SI" Then GoTo 150  'baja si o no
         If Hoja3.Cells(j, 21) = "" Then GoTo 150  'Responsable
        Instrum = Hoja3.Cells(j, 6).Text 'Datos Instrumentos, Instrumento
        Estatus = "VIGENTE"
        With Worksheets("Datos calibración").Range("a1:a9000") 'hoja4
            Set c = .Find(Instrum, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    Fila = c.Row
                    If UCase(Left(Hoja4.Cells(Fila, 16).Text, 11)) = "NUEVO CICLO" Then GoTo 100
                    If Left(Hoja4.Cells(Fila, 16).Text, 15) = "BAJA DEFINITIVA" Then GoTo 150 'observaciones
                    If Hoja4.Cells(Fila, 15) < Hoy Then
                        Estatus = "VENCIDO"
                    Else
                        Estatus = "VIGENTE"
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
        If Estatus = "VENCIDO" Then
100
            cont = cont + 1
            Hoja8.Cells(cont, 1) = Hoja3.Cells(Fila, 6)
            Hoja8.Cells(cont, 2) = Hoja3.Cells(Fila, 4)
            Hoja8.Cells(cont, 3) = Hoja3.Cells(Fila, 5)
            
            Hoja8.Cells(cont, 4) = Hoja4.Cells(Fila, 12)
            Hoja8.Cells(cont, 5) = Hoja4.Cells(Fila, 15)
            Hoja8.Cells(cont, 6) = Hoja3.Cells(Fila, 21)
            
            If Hoja4.Cells(Fila, 16) <> "" Then
                If Hoja4.Cells(Fila, 15) = "" Then
                    Hoja8.Cells(cont, 2) = Hoja4.Cells(Fila, 16)
                End If
            End If
            If UCase(Left(Hoja4.Cells(Fila, 16).Text, 11)) = "NUEVO CICLO" Then
                Hoja8.Cells(cont, 2) = UCase(Hoja4.Cells(Fila, 16).Text)
            End If
        End If
            
150
    Next j

  
End Sub

Private Sub CommandButton1_Click()

End Sub

Private Sub cmbRepovenc_Click()
    Reporte
End Sub

Y adjunto el archivo original (parte) solo mil registros, esta tabla la copy and paste en el archivo que revisaste y solo run y da los datos de las columnas de fechas (dos columnas). 

voy a seguir buscando sobre esto, mil gracias por tu apoyo.

saludos.

Hoja Datos de Calibracion - copia.xlsb

Saludos @asalinasc, utiliza esta macro, le realice unos pequeños ajustes, debería funcionarte sin problemas, sin embargo me parece que esta macro se puede mejorar bastante

 

Sub Reporte()
Dim Instrum, Estatus As String
Dim Hoy
Dim cont, Fila As Integer

    
    'On Error Resume Next
    Range("a4:G6000").Select
    Selection.ClearContents
    Range("a1").Select
    Hoy = Now
    cont = 3
    For j = 2 To 5000
        If Hoja3.Cells(j, 1) = "" Then Exit For 'numero de serie
        If Hoja3.Cells(j, 4) = "" Then GoTo 150  'Descripcion
        If Hoja3.Cells(j, 5) = "" Then GoTo 150  'Marca
        If Hoja3.Cells(j, 23) = "SI" Then GoTo 150  'baja si o no
        If Hoja3.Cells(j, 21) = "" Then GoTo 150  'Responsable
        Instrum = Hoja3.Cells(j, 6).Text 'Datos Instrumentos, Instrumento
        Estatus = "VIGENTE"
        With Worksheets("Datos calibración").Range("A1:A50000") 'hoja4
            Set c = .Find(Instrum, LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    Fila = c.Row
                    If UCase(Left(Hoja4.Cells(Fila, 16).Text, 11)) = "NUEVO CICLO" Then GoTo 100
                    If Left(Hoja4.Cells(Fila, 16).Text, 15) = "BAJA DEFINITIVA" Then GoTo 150 'observaciones
                    If Hoja4.Cells(Fila, 15) < Hoy Then
                        Estatus = "VENCIDO"
                    Else
                        Estatus = "VIGENTE"
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
        
        If Estatus = "VENCIDO" Then
100
            cont = cont + 1
            Hoja8.Cells(cont, 1) = Hoja3.Cells(j, 6)
            Hoja8.Cells(cont, 2) = Hoja3.Cells(j, 4)
            Hoja8.Cells(cont, 3) = Hoja3.Cells(j, 5)
            
            Hoja8.Cells(cont, 4) = Hoja4.Cells(Fila, 12)
            Hoja8.Cells(cont, 5) = Hoja4.Cells(Fila, 15)
            Hoja8.Cells(cont, 6) = Hoja3.Cells(Fila, 21)
            
            If Hoja4.Cells(Fila, 16) <> "" Then
                If Hoja4.Cells(Fila, 15) = "" Then
                    Hoja8.Cells(cont, 2) = Hoja4.Cells(Fila, 16)
                End If
            End If
            If UCase(Left(Hoja4.Cells(Fila, 16).Text, 11)) = "NUEVO CICLO" Then
                Hoja8.Cells(cont, 2) = UCase(Hoja4.Cells(Fila, 16).Text)
            End If
        End If
            
150
    Next j

    
End Sub

 

 

 

Cheque de nuevo tu macro y por algun razon que aun no entiendo el contador for j=2 to... se detiene al llegar a 51, checa el archivo le puse una macro dinamica, cada que la corras va a contar cuantas filas hay en la hoja instrumentos y cuantas en la hoja calibraciones, sobre ambas cantidades va a efectuar las comparaciones todos los calculos y resultados los hace y guarda en la memoria, una vez que acaba los descarga en la hoja vencidos, por cierto si presente problemas checa las fechas tienes varias con 29/02/2006, 2006 no es bisiesto y la macro se salta esos registros por considerarlos textos, en la hoja instrumentos verifica que los codigos sean unicos si estan repetidos la macro tomara los resultados de la primera fila que coincida.

Rep.rar

Buenos días, agradezco  su gran apoyo y que se tomen la molestia de apartar algo de su valioso tiempo, quiero comentar sobre @bigpetroman, la macro funciona solo que no arroja los datos en la columna responsable, pero voy a ver si puedo hacer que los jale y los muestre.

En la macro @Dr Hyde al hacerla dinámica me funciona mucho mejor de lo que era la original, solo tengo unas dudas:

la intención de hoja vencidos es para mostrar únicamente los equipos vencidos, creo que la macro original así estaba, se incluían  datos de equipos vencidos y no vencidos,  pero quería ver si se puede claro que en vez de mostrar todos los equipos, solamente se mostraran aquellos que están vencidos, es decir establecer otro criterio el dato de la Columna P (Observaciones) de la hoja "Datos Calibración" todo lo que diga "Nuevo Ciclo" o "Requiere Nuevo Ciclo",  que aparezca en la hoja "Vencidos" como resultado de la macro, claro no que aparezca la leyenda subrayada, sino únicamente filtrar los equipos con ese  criterio y que sean valores únicos sin que se repitan los equipos como en la columna A de la hoja Vencidos, pero repito así es como estaba la macro original, siendo que no debe ser así, . muchas gracias Big y Dr, por su gran ayuda y consejos, pero sobre todo por sus conocimientos y aportación,  ojala y se pueda encontrar  algo, por lo pronto estoy aprendiendo cada día mas en este foro de como las macros pueden mejorarse como bien lo comentan ustedes.

thanks,

saludos.

la macro original tiene dos criterios que inclui en la nueva macro

1.-         If Left((FILAC(1, 16)), 15) = "BAJA DEFINITIVA" Or UCase(FILAC(1, 23)) = "SI" Then GoTo SIGUIENTE

en este caso el instrumento o equipo estan dados de baja en automatico descarta ese archivo y pasa al siguiente

2.- If FEC < Date Or UCase(Left(FILAC(1, 16), 11)) = "NUEVO CICLO" Then esta condicion doble lo que hace es que si la fecha de vigencia esta vencida lo agrega a la hoja vencidos 

o si en la columna P (OBSERVACIONES) encuentra la frase nuevo ciclo tambien lo manda a la hoja vencidos aunque todavia la fecha este vigente, si quieres solo los que esten vencidos entra a VBA y

cambia la linea

If FEC < Date Or UCase(Left(FILAC(1, 16), 11)) = "NUEVO CICLO" Then

por:

If FEC < Date Then

asi solo tendras los instrumentos o equipos cuya fecha ya no este vigente.

de lo que comentas sobre valores unicos no me ha quedado claro cual es el resultado que quieres lograr.

 

 

Gracias Dr hyde voy a darle un review a la mejor me confundí sola, voy a aplicar tus comentarios y te comento.

 

voy a revisar lo de los datos duplicados no sea que yo le moví algo a la macro y lo deje así (como el archivo adjunto).

 

saludos.

Rep - copia.xlsb

no le moviste a nada, pasa lo siguiente 

la hoja de calibraciones es un historial de calibraciones hasta ahorita me di cuenta asi que la programacion debe ser diferente para filtrar registros unicos y que solo tome en cuenta el ultimo registro de cada instumento, (es algo facil solo se lleva un poco de tiempo), entonces si tendras resultados unicos en la hoja vencidos.

esta macro no considera valores repetidos, en la hoja vencidos ya solo pondra valores unicos, nota: la macro toma como referencia la ultima fecha de cada instrumento en particular es decir si tienes 8 CA-10, la macro tomara la ultima fecha de esos 8 registros, solo verifica que en la hoja instrumentos no tengas valores repetidos ya que la macro tomara como erl primer valor que encuentre en esa hoja.

Rep.rar

Buen dia, Dr Hyde muchas agracias por tu macro, pegue la macro al archivo original y me marca error 400, pero estoy reviewing, porque en el archivo que subiste si funciona bien, estoy viendo que puede estar causando ese error, saludos.

checa este link sobre el error 400 https://www.add-ins.com/support/microsoft-visual-basis-error-400.htm

Buen dia otra vez Dr Hyde, yo otra vez, sabes que ahora le hice al reves, es decir al archivo que me enviaste le pegue los datos completos del archivo original (las hojas: Datos Instrumentos y Datos Calibracion) tal y como estan (solo cambie las referencias de las fechas que estaban mal capturadas para que todas estuvieran en un solo formato y uniformes) y el resultado que me da al run la macro es como la primas foto, despues le doy al boton del aviso (depurar) y me sale la otra foto de abajo en amarillo, si copio tu macro al archivo original le doy run a la macro y me sale error 400, ya revise no tengo complementos, tengo enable las macros, pero estoy buscando en el archivo que puede estar mal.

 

saludos.

Hace 22 minutos , Dr Hyde dijo:

checa este link sobre el error 400 https://www.add-ins.com/support/microsoft-visual-basis-error-400.htm

The problem my office is 2013 and 2016 I'm looking for that, voy a seguir o tratar con un PC con office anterior. thanks

Solo hay dos maneras de que te ponga un error 1004 una es que la funcion busqueda no encuentre nada y la otra que cuenta sea igual a 0

trata añadiendo la linea en negrita en la macro

celda=busca.address

cuenta=worksheetfunction.countif(dca.columns.count,instru)

if busca is nothing or cuenta=0 then siguiente

set equipo=dc.range(celda).resize(cuenta.dca.columns.count)

verifica que en la hoja calibraciones no tengas un dato que no este dado de alta tambien en la hoja instrumentos, esto tambien origina ese error

si la instruccion no funciona

usa estas lineas

celda=busca.address

cuenta=worksheetfunction.countif(dca.columns.count,instru)

on error resume next

set equipo=dc.range(celda).resize(cuenta.dca.columns.count)

on error goto 0

con eso se salta el error y continua con el programa, la otra en el menu de vBA activa las ventanas locales, corre la macro y cuando te aparezca el error das depurar, hay veras en que parte del archivo se produce el error, capturas la pantalla y la pones la foto aqui para ver que esta produciendo el error, eso lo haces antes de modificar la macro.

 

Hace 46 minutos , Dr Hyde dijo:

if busca is nothing or cuenta=0 then siguiente

Dr Hyde al parecer ya quedo solo le agregue GoTo antes de siguiente, quedo como el código de abajo:

If busca Is Nothing Or cuenta = 0 Then GoTo SIGUIENTE

lo puse en el archivo que me enviaste y en el archivo original y en los dos run muy bien, ya no intente :  on error resume next y  on error goto 0, anyway voy a hacer unas pruebas mas (con la información a dejar un solo formato y ver como bien dices algo que por ahi no este dado de alta y que este en una pestaña y que en la otra no, para asegurar que los todos los instrumentos estén incluidos en ambas pestañas, let me chance para ver algunos detalles si esque hay y sino para concluir este tema, voy a revisar y te comento ok.

saludos.

Bueno ya hice alguna revisión a los datos por ahí, solo quería darle las gracias a @bigpetroman y, @LeandroA, por su apoyo y en especial al @Dr Hyde por su aportación y mejorar en gran manera las macros que estaba manejando, gracias por su paciencia y explicarme con detalle, mil gracias a todos nuevamente y definitivamente este archivo quedo mucho mejor de lo que había visualizado inicialmente, por lo cual doy por Solucionado este tema.