---

MS Excel 2003: Macro to warn when a record will expire within 31 days

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.

Macro 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