Filtrar un base con VBA para borrar las filas dependiendo de una fecha que esta en una hoja diferente

Tengo una pequeña base de datos y necesito borrar toda las filas que me sean mayores a una fecha que tengo en una hoja que se llama "BASE"

Es decir tengo 100 filas y 100 Columnas en una hoja que se llama ("TRABAJO") y necesito borrar todas las filas que la fecha sea mayor a una fecha que esta en la hoja ("BASE") en la celda ("B2")

No logro dar con el código aún.

2 respuestas

Respuesta
1

El código es sencillo, como no pusise un ejemplo de como esta estructurada tu información supuse que esta comienza en la celda a1 de la hoja trabajo y que en esa misma celda están las fechas, esta macro lee el valor de la celda A2 de la hoja base, partiendo de hay cuenta cuantas fechas hay superiores al valor leído y busca en que fila comienza esta localizada la fecha, una vez encontrada selecciona todas las fechas que cumplan con la condición y te las muestra, si quieres borrarla solo activa la línea que tiene una palomita volando quitando la palomita y es todo, los únicas instrucciones que tienes que cambiar (si se requiere) es a1 y el valor de columns(1) por ejemplo si tus datos comienzan en c4 y la fecha esta en f5, cuentas a partir de c4 hasta f5 en este caso son 4 columnas y cambias el 1 por 4, otra cosa las información tiene que estar ordenada por fechas de preferencia ascendente.

Sub borrar()
fecha = Sheets("base").Range("b2")
Set h1 = Worksheets("trabajo")
Set DATOS = h1.Range("a1").CurrentRegion
With DATOS
    cuenta = WorksheetFunction.CountIf(DATOS.Columns(1), ">" & CDbl(fecha))
    vacio = cuenta > 0
    If cuenta > 0 Then
        fila = WorksheetFunction.Match(CDbl(fecha), DATOS.Columns(1), 0)
        .Rows(fila + 1).Resize(cuenta).Select
        '.Rows(fila + 1).Resize(cuenta).ClearContents
    End If
End With
Set DATOS = Nothing
End Sub

Hola si que pena, 

la fecha que da el criterio para el filtro esta en la hoja ("Base").Range("B2")

La base esta en la Hoja ("Trabajo"), la base tiene Títulos ("1:1"), en la columna ("FB") están las fechas de todo el año, esto quiere decir que las fechas en si comienzan en ("FB2").

necesito es que si la fecha de esa Columna es mayor a la de la hoja ("Base").Range("B2") me borre toda la fila. 

ahí variaría mucho el código que me acabas de informar?

Que hay antes de la columna FB, ¿en la columna FB comienza la tabla?, ¿Y otra cosa quieres borrar la información de la fila? ¿O quieres eliminar la fila?, como sugerencia te recomiendo subir una imagen de como tienes tu información así es más fácil adaptarte la macro.

Quiero que elimine esa fila toda. (dejarlas en blanco NOOOO)

Hola esta es la base de datos 1

La base arranca en la A1 con el titulo Proceso, las fechas arrancan en la FB2 como se muestra a continuación. 

también lo voy hacer a esta, pero con base en la anterior hago esta

Por lo grande la base tuve que ocultar algunas columnas, pero estas no van a estar ocultas mientras corra la macro!

Este ejemplo de la macro funcionado, en el rango b2 de la hoja base la fecha es 21/08/2018, la macro primero va a ordenar tu base por fechas en forma ascendente, luego se va a ir a la columna BF y va a contar cuantas fechas son superiores a la fecha ingresada, después se va a posicionar un la primera fecha con fecha superior a la ingresada y la va a borrar, en este caso y como ejemplo pinte el rango que va a borrar de amarillo, la instrucción para borrar esta inactiva solo quítale la palomita y listo, solo borra la línea anterior a esta que es la que hace el pintado

aqui esta la macro

Sub borrar()
FECHA = Sheets("base").Range("b2")
Set H1 = Worksheets("trabajo")
Set datos = H1.Range("a1").CurrentRegion
With datos
r = .Rows.Count: c = .Columns.Count
CFECHA = Range("bf1").Column
.Sort KEY1:=H1.Range(.Columns(CFECHA).Address), ORDER1:=xlAscending, Header:=xlYes
    Set datos = .Rows(2).Resize(r - 1, c)
    cuenta = WorksheetFunction.CountIf(datos.Columns(CFECHA), ">" & CDbl(FECHA))
    vacio = cuenta > 0
    If cuenta > 0 Then
    AVISO = MsgBox("SE ENCONTRARON " & cuenta & _
    " FECHAS MAYORES A " & FECHA & " QUIERE ELIMINARLAS? ", vbYesNo, "AVISO EXCEL")
    VALIDA = AVISO = 6
        If VALIDA Then
        fila = WorksheetFunction.Match(CDbl(FECHA), datos.Columns(CFECHA), 0)
        .Rows(fila + 1).Resize(cuenta).Interior.ColorIndex = 6
        '.Rows(fila + 1).Resize(cuenta).EntireColumn.Delete
        Else
            End
        End If
    Else
        MsgBox ("NO SE ENCONTRO NINGUN REGISTRO CON FECHA SUPERIOR A " & FECHA), _
        vbInformation, "AVISO EXCEL"
    End If
End With
Set datos = Nothing
End Sub

¡Gracias! 

si me dice cuantos son los registros que va a borrar, 

fila = WorksheetFunction.Match(CDbl(FECHA), datos.Columns(CFECHA), 0)

En esta parte dice que no se puede obtener la Propiedad Match de la Clase

le quite la palomita como menciono anteriormente.

Pon una imagen cuando te aparece el error, necesito ver el numero de error que sale y si la cuenta de los registros es mayor a 0

es este, le doy depurar y me resalta el código que envié anteriormente.

Este error se presenta cuando la fecha que tienes en el rango b2 de la hoja base no existe en la hoja trabajo o bien existe pero como texto, ya le hice algunas modificaciones a la macro por favor ignora la macro anterior y usa esta, en el caso de la imagen tecle el 21/08/2018 observa que esa fecha no existe, ahora lo que hace es que se posiciona el ultimo registro exista o no la fecha y la colorea de amarillo todas las fechas a borrar, abajo de la isntruccion para colorear palomeada esta la instruccion para borrar, ojo tambien se puede presentar el error si la fecha en la hoja base es texto

Aqui esta l macro corregida

Sub borrar_filas()
Set h1 = Worksheets("trabajo")
FECHA = Sheets("base").Range("b2")
Set datos = h1.Range("a1").CurrentRegion
cfecha = h1.Range("bf1").Column
With datos
    .Sort key1:=h1.Range(.Columns(cfecha).Address), order1:=xlAscending, Header:=xlYes
    r = .Rows.Count
    CUENTA = WorksheetFunction.CountIf(.Columns(cfecha), ">" & CDbl(FECHA))
    VALIDA = CUENTA > 0
    If CUENTA Then
        ASK = MsgBox("HAY " & CUENTA & " FILAS MAYORES A " & FECHA, vbYesNo, "CONFIRMAR BORRADO")
        VALIDA = ASK = 6
        If VALIDA Then
            .Rows(r - CUENTA + 1).Resize(CUENTA).Interior.ColorIndex = 6
            '.Rows(r - cuenta + 1).Resize(cuenta).ClearContents
        Else
            End
        End If
    End If
End With
Set datos = Nothing
End Sub
Respuesta

Esto puede aportar algo

https://www.programarexcel.com/2013/05/macro-vba-recorre-filas-busca-y-copia.html

https://youtu.be/LkiQIzCsWP8

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas