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
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 SubSi 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
.
