This Excel tutorial explains how to write a macro to warn when a record will expire within 31 days in Excel 2003 and older versions (with screenshots and step-by-step instructions).
Question: We work with subcontractors who have insurance certificates that expire at various dates. We store these certificates and expiry dates in Microsoft Excel 2003/XP/2000/97.
Is there a way in Excel to warn me when a particular certificate is about to expire?
Answer: There are several "events" available within an Excel spreadsheet where you can place VBA code. In your case, we want to place our code in the "Workbook_Open" event.
Let's look at an example.
Download Excel spreadsheet (as demonstrated below)
In our spreadsheet, there is a sheet called Sheet1. In column C, we store the expiry date for each insurance certificate.
When the Excel file is opened, the VBA code on the "Workbook_Open" event automatically runs to check the first 200 rows in this spreadsheet. Each row is checked to see if the certificate will expire in the next 31 days.
In our example, we've opened the file on Sept 1, 2003. In this case, we will get the following warning message:
The macro will generate one warning message for each certificate that will expiry within the next 31 days.
You can press Alt-F11 to view the VBA code.
The macro code looks like this:
Private Sub Workbook_Open() Dim LRow As Integer Dim LResponse As Integer Dim LName As String Dim LDiff As Integer Dim LDays As Integer LRow = 2 'Warning - Number of days to check for expiration LDays = 31 'Check the first 200 rows in column C While LRow < 200 'Only check for expired certificate if value in column C is not blank If Len(Sheets("Sheet1").Range("C" & LRow).Value) > 0 Then LDiff = DateDiff("d", Date, Sheets("Sheet1").Range("C" & LRow).Value) If (LDiff > 0) And (LDiff <= LDays) Then 'Get subcontractor name LName = Sheets("Sheet1").Range("A" & LRow).Value LResponse = MsgBox("The insurance certificate for " & LName & " will expire in " & LDiff & " days.", vbCritical, "Warning") End If End If LRow = LRow + 1 Wend End Sub
(scroll to see more)