Mostrar alerta 15 días antes a fecha de vencimiento VBA Excel

Necesito nuevamente de su sabiduría, tengo una hoja que contiene 2 fechas una la fecha de inicio (Columna desde N5 hasta la ultima fila) y la fecha fin (Columna O5 hasta la ultima fila) el caso es que quisiera que la columna O se compare con la fecha de hoy, me pueda mostrar alertas de mensajes 15 días antes de llegar a la fecha de vencimiento, y dichos datos se copien a una hoja aparte, tengo este código pero no se como adaptar los 15 días antes de hoy y me mueestre la alerte, dejo mi código para que se pueda adaptar a lo que requiero, mucgas gracias:

Sub Alertas()
On Error Resume Next
    Application.ScreenUpdating = False
        Set h1 = Sheets("BD")
        Set h2 = Sheets("Vencidas")
        h2.UsedRange.Offset(3, 0).ClearContents
        '
            datos = h2.Range("A" & Rows.Count).End(xlUp).Row
        '
        j = 3
        n = 0
        For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
            If h1.Cells(i, "O") = Date Then
                h1.Range("D" & i & ",H" & i & ",K" & i & ",L" & i & "," & _
                         "M" & i & ",N" & i & ":O" & i & ",P" & i).Copy
                h2.Cells(j, "B").PasteSpecial xlValues
                j = j + 1
                n = n + 1
            End If
        Next
        Application.CutCopyMode = False
        Call AutoAjustarColumns
        MsgBox n & "  Autoridad(es) que hoy finalizán su gestión, revise la hoja" & vbCrLf & _
        "“Autoridades Vencidas” para comunicar", vbCritical, "Advertencia!"
    Application.ScreenUpdating = True
End Sub

1 Respuesta

Respuesta
2

Prueba con lo siguiente y me comentas. Crea la hoja "Alertas" para poner en esa hoja los registros con alerta

Sub Alertas()
    On Error Resume Next
    Application.ScreenUpdating = False
    Set h1 = Sheets("BD")
    Set h2 = Sheets("Vencidas")
    Set h3 = Sheets("Alertas")
    h2.UsedRange.Offset(3, 0).ClearContents
    h3.UsedRange.Offset(3, 0).ClearContents
    '
    datos = h2.Range("A" & Rows.Count).End(xlUp).Row
    '
    j = 3
    k = 3
    n = 0
    For i = 1 To h1.Range("A" & Rows.Count).End(xlUp).Row
        'Alertas
        If h1.Cells(i, "O") + 15 = Date Then
            h1.Range("D" & i & ",H" & i & ",K" & i & ",L" & i & "," & _
                     "M" & i & ",N" & i & ":O" & i & ",P" & i).Copy
            h3.Cells(k, "B").PasteSpecial xlValues
            k = k + 1
            'n = n + 1
        End If
        '
        'Vencidas
        If h1.Cells(i, "O") = Date Then
            h1.Range("D" & i & ",H" & i & ",K" & i & ",L" & i & "," & _
                     "M" & i & ",N" & i & ":O" & i & ",P" & i).Copy
            h2.Cells(j, "B").PasteSpecial xlValues
            j = j + 1
            n = n + 1
        End If
    Next
    Application.CutCopyMode = False
    Call AutoAjustarColumns
    MsgBox n & "  Autoridad(es) que hoy finalizán su gestión, revise la hoja" & vbCrLf & _
        "Autoridades Vencidas” para comunicar", vbCritical, "Advertencia!"
    Application.ScreenUpdating = True
End Sub


Si es lo que necesitas no olvides valorar.

.

.

Hola Dante, gracias por el apoyo, ¿pero no logro entender que tan necesario es crear una adicional? Ahora seguí tus instrucciones y me copia los datos a la hoja alertas pero no se que criterio se esta empleando ahí para que copie y en la hoja vencidas no copia nada, cree dos registros supuestamente que están en los 15 días antes a la fecha de hoy y no muestra nada... ¿qué estaré haceiendo mal? Gracias

Tú solicitaste esto:

"Y dichos datos se copien a una hoja aparte", como no pusiste como se llama la "hoja aparte", te propuse que crearas la hoja "alertas".

Ahora bien, el criterio para copiar en la hoja "alertas" es cuando la fecha está 15 días antes, si hoy es 25 de abril, entonces los registros con fecha 10 de abril (25-15 = 10), serán copiados a la hoja "alertas".

El criterio para copiar en la hoja "vencidas" es cuando la fecha es igual a hoy, si hoy es 25 de abril, entonces los registros con fecha 25 de abril serán copiados a la hoja "vencidas".

.

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas