Pop up message to warn of date expiring?

[Geo]

Is there a way to have a message box pop up to warn of a date about to expire
and to warn when expired too?

 

[Jacob Skaria]

You can use conditional formatting to highlight the dates about to expire in
one color (say Orange) and dates expired in another (say Red)

1. Select the column with dates (say Column D). Please note that D1 which is
mentioned in this formula is the first cell of the selection.

2. From menu Format>Conditional Formatting>

3. For Condition1>Select 'Formula Is' and enter the below formula
=AND(D1-TODAY()>0,D1-TODAY()<5)
Click Format Button>Pattern and select your color (say Orange)

4. Click on Add button.

5. For Condition2>Select 'Formula Is' and enter the below formula
=AND(D1>0,D1-TODAY()<=0)
Click Format Button>Pattern and select your color (say Red)

6. Hit OK

If this post helps click Yes

 

[Geo]

Thanks Jacob for getting back so quick.
I thought about using conditional formatting (might still do!) but the file
I have the date are on one worksheet but the working sheet is a different
one. I was hoping that as a date in sheet(2) is about to expire a message
would pop up on sheet(1) as it's being used.

 

[Billy Liddel]

I got the sheets wrong but you might use a sheet activate event. The
following asumes that there is a named range for the expiry dates (rngExpire)
and that the unit is in 2 columns to the right of the date.

Click on the worksheet(1) tab choose View Code and paste in the code. and
edit it to suit.

Private Sub Worksheet_Activate()
Dim rngExpireDate As Range
Dim c
Dim dtCheck As Date

dtCheck = Int(Now())

Set rngExpireDate = Sheets("Sheet1").Range("RngExpire")
For Each c In rngExpireDate
If c < dtCheck Then
MsgBox c.Offset(0, -2) & " Is due to expire in " & dtCheck - c & " days"
End If
Next
End Sub

HTH
Peter Atherton

 

[Jacob Skaria]

Hi Geo

The below macro displays a notification message with the total dates
expired/close to expiry and activate the sheet; and also highlights the cells
for easy identification. You can either call this from sheet Activate event
or even run as a separate macro whenever you need. Try and feedback

Private Sub Worksheet_Activate()
Call ExpiryNotification
End Sub


Sub ExpiryNotification()
Dim ws As Worksheet, rngTemp As Range
Dim lngRow As Long, lngExp As Long, lngWarn As Long
'Adjust the sheet name to suit
Set ws = Worksheets("Sheet1")
Set rngTemp = ws.Range("rngDate")

'Adjust the date column to suit. For this example it is A
'Assume you have header in row 1; and date starts from row 2
For lngRow = 2 To ws.Cells(Rows.Count, rngTemp.Column).End(xlUp).Row
If ws.Cells(lngRow, rngTemp.Column) > 0 Then
ws.Cells(lngRow, rngTemp.Column).Interior.ColorIndex = 0
If ws.Cells(lngRow, rngTemp.Column) <= Date Then
ws.Cells(lngRow, rngTemp.Column).Interior.ColorIndex = 3
lngExp = lngExp + 1
ElseIf ws.Cells(lngRow, rngTemp.Column) < Date + 5 Then
ws.Cells(lngRow, rngTemp.Column).Interior.ColorIndex = 6
lngWarn = lngWarn + 1
End If
End If
Next
If lngWarn + lngExp > 0 Then MsgBox "Dates expired : " & _
lngExp & vbCrLf & "Due to expire : " & lngWarn, _
vbInformation, ws.Name: ws.Activate
End Sub

 

[Geo]

Thank you all for your suggestions. I will try them both and reply with the
results soon.

 

[Geo]

Thanks Jacob,
With afew changes it works well.

Thank you all for your suggestions. I will try them both and reply with the
results soon.

 

[Toby]

Does'nt seem to work is the formula correct if this would work it would be
perfect