Macro que me avise el vencimiento de una fecha pasada 3 días
Para Dante Amor,
Mi caso es el siguiente:
Tengo una hoja de calculo donde en la fila "b" (desde B2 hasta B115) tengo fecha de inicio y en la fila "c" (desde C2 hasta C115) fecha de cierre, y cuando ingrese una fecha en fecha de inicio lo que necesito es que pasado tres días me avise pintándose de rojo la celda, pero que no me cuente los domingos y en ocasiones en la fila de fecha de cierre llego anotar pendiente o en proceso y que esas no se pinten.
Espero me puedas ayudar y si no me explique bien te pido me avises.
ok muchas gracias
Te anexo 2 macros que va en los eventos de thisworkbook, ambas funcionan solamente para las hojas "SWAP INST" y "LTE INST ", si quieres que funcione para más hojas, deberás modificar ambas macros; en esta línea agrega las siguientes hojas:
Case "SWAP INST", "LTE INST "
Por, ejemplo si quieres agregar la hoja "MICROBTS ", la línea en ambas macros deberá quedar así:
Case "SWAP INST", "LTE INST ", "MICROBTS "
Nota: Revisa el nombre de tus hojas, porque en varias tienes al final del nombre un espacio.
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Por.Dante Amor
Select Case Sh.Name
Case "SWAP INST", "LTE INST "
Application.ScreenUpdating = False
u = Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & u).Interior.ColorIndex = xlNone
For i = 2 To u
n = 0
If IsDate(Cells(i, "B")) Then
For j = Cells(i, "B") To Date
If n >= 3 Then
Cells(i, "B").Interior.ColorIndex = 3
End If
If Not Weekday(Cells(i, "B"), 1) Then
n = n + 1
End If
Next
End If
Next
End Select
End Sub
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Por.Dante Amor
Select Case Sh.Name
Case "SWAP INST", "LTE INST ", "MICROBTS "
If Not Intersect(Target, Range("B:B")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Target.Interior.ColorIndex = xlNone
If IsDate(Target.Value) Then
n = 0
For j = Target.Value To Date
If n >= 3 Then
Target.Interior.ColorIndex = 3
End If
dia = Weekday(Target, 1)
If Not Weekday(Target, 1) Then
n = n + 1
End If
Next
End If
End If
End Select
End SubPara ver las macros:
- Abre tu libro de excel
- Para abrir Vba-macros y ver la macro, Presiona Alt + F11
- Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
Saludos. Dante Amor
Si es lo que necesitas.
Hola Dante muchas gracias, funciona muy bien puesto que no marca error, solo que quedo al revés y tengo una duda, la fila que quiero se marque es la "C" que es la fecha de cierre, por lo general las celdas de la fila "C" a veces las tengo ya con una fecha de cierre y para no estar buscando cual excedió el plazo entonces al paso de los 3 días de la fecha de inicio que tengo en la fila "B" se pinten, y se podrá que no importa que vaya a la fecha de hoy? si no que cumpla la función de que pasando 3 días me avise por que por ejemplo tengo una fecha 18/ene/15 y cerro el día 20/ene/15 entonces ahí no excedió los 3 días de plazo pero aun así se pinto, y otra duda ¿tengo que ejecutar la macro o automáticamente los marcara? te agradezco mucho por tu atención y si no me explique bien te pido me lo hagas saber.
Saludos..
Para que funcione contra la fecha de cierre, deberás poner únicamente una fecha, y en tu celda estás poniendo una fecha y un comentario. Tendrás que poner el comentario en otra celda.
Modifica tu archivo para dejar únicamente fechas en la fecha de cierre y me lo envías nuevamente.
Las macros se ejecutan en automático.
Muchas gracias Dante por contestar, en un momento to lo envío
Te anexo las nuevas macros
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'Por.Dante Amor
Select Case Sh.Name
Case "SWAP INST", "LTE INST ", "MICROBTS "
Application.ScreenUpdating = False
u = Range("C" & Rows.Count).End(xlUp).Row + 1
Range("C2:C" & u).Interior.ColorIndex = xlNone
For i = 2 To u
n = 0
If IsDate(Cells(i, "B")) And IsDate(Cells(i, "C")) Then
For j = Cells(i, "B") To Cells(i, "C")
If n >= 3 Then
Cells(i, "C").Interior.ColorIndex = 3
End If
If Not Weekday(Cells(i, "B"), 1) Then
n = n + 1
End If
Next
End If
Next
End Select
End Sub
'
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Por.Dante Amor
Select Case Sh.Name
Case "SWAP INST", "LTE INST ", "MICROBTS "
If Not Intersect(Target, Range("B:C")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Range("C" & Target.Row).Interior.ColorIndex = xlNone
If IsDate(Range("B" & Target.Row)) And IsDate(Range("C" & Target.Row)) Then
n = 0
For j = Range("B" & Target.Row) To Range("C" & Target.Row)
If n >= 3 Then
Range("C" & Target.Row).Interior.ColorIndex = 3
End If
dia = Weekday(Target, 1)
If Not Weekday(Target, 1) Then
n = n + 1
End If
Next
End If
End If
End Select
End Sub
