Necesito auto aviso excel para fecha de vencimiento en macro

Dante como te va;

Consulta, como puedo modificar esta macro para que con una columna con fechas de vencimientos dadas (datos) pueda verificar mediante un botón de comando (con Macro dentro) los días que restan para el arribo del vencimiento? (Si es posible que indique restan xx dias para el vencimiento)

Para el caso de que la celda con la fecha chequeada este vencida, la misma debería parpadear en rojo.

Te agradezco el aporte que haces en este tema, ya que no somos para nada expertos en VSB.

Te anexo la macro con la que puedes verificar las fechas, para ello debes seguir los siguientes pasos:

1. Abre un libro de excel

2. En la columna C, desde la celda C2, hacia abajo, captura las fechas a validar

3. En la celda D1 escribe la fecha final

4. En la columna E te van a aparecer los resultados

Te anexo una imagen en el siguiente link para que veas como queda.

http://www.subeimagenes.com/img/valida-a-15-dias-409324.html

Los siguientes pasos son para crear la macro

5. Presiona Alt + F11 para abril Microsoft Visual Basic (Macros)
6. Selecciona del menú: Insertar y luego Módulo
7. Inserta el código de la macro en el panel derecho
8. Presiona F5 para ejecutar la macro

Código de la macro para copiar en el panel

*******

Sub alertas()
'Creada por DAM
i = 2
Dim zhoy As Date
Dim dfaltan, dhabiles, dhabilesnetos, dsemana As Integer
' dfaltan = InputBox(Prompt:="Aviso de días", Title:="ALERTA DE DÍAS", Default:="15")
' dhabiles = InputBox(Prompt:="Días hábiles", Title:="Días", Default:="4")
'zhoy = Date
zhoy = Range("D1")
dfaltan = 15
dhabiles = 4
dhablesnetos = 1
dsemana = Weekday(zhoy, 1)
'MsgBox dsemana
Select Case dsemana
Case 1 'Domingo
dhabilesnetos = dhabiles + 1
Case 2 'Lunes
dhabilesnetos = dhabiles + 2
Case 3 'Martes
dhabilesnetos = dhabiles + 2
Case 4 'Miércoles
dhabilesnetos = dhabiles + 2
Case 5 'Jueves
dhabilesnetos = dhabiles + 2
Case 6 'Viernes
dhabilesnetos = dhabiles
Case 7 'Sábado
dhabilesnetos = dhabiles
End Select
Range("E:E").Clear
Do Until Cells(i, 3) = ""
If Cells(i, 3).Value + dfaltan = zhoy Then
Cells(i, 5) = "Faltan " & dfaltan & " días"
End If
'If Cells(i, 3).Value >= zhoy - dhabiles And Cells(i, 3).Value <= zhoy - 1 Then
If Cells(i, 3).Value = zhoy - dhabilesnetos Then
Cells(i, 5) = "Faltan " & dhabiles & " días hábiles"
End If
i = i + 1
Loop
End Sub

**********