VBA pop-up message box for dates

[user8314]

I am have a spreadsheet that I would like to get a pop-up msg box on upcoming expiration dates upon opening the workbook . My spreadsheet is like this:
Column A - Driver Name
Column F-I - Have various different expiration dates
Sseveral columns beyond, with other driver information

I am trying to add a message box that will alert 10 days before the date any of the expiration dates. For example "Driver Name has an upcoming expiration date in 10 days " according to the date.
Would appreciate any help with this vba, thank you!

 

[ranman256]

you could use a msg box but it could get busy with many messages. The code below writes a message to a cell about the status and colorizes the offending cell.

paste this code into a module ,
here the message is written in : Const kiCellMsg = 9 ,as in 9 cells from A, (so J) so you can change the column offset for your sheet.

Option Explicit
Sub DateAlerts()
Dim vDat As Date
Dim vName, vMsg
Dim iOff As Integer, d As Integer
Const kiCellMsg = 9
Dim bAlert As Boolean, bIsDirty As Boolean

Range("A2").Select
While ActiveCell.Value <> ""
   bIsDirty = False
   vName = ActiveCell.Offset(0, 0).Value
   
  For iOff = 5 To 8
 
      vDat = ActiveCell.Offset(0, iOff).Value
      If IsDate(vDat) And vDat <> "12:00:00 AM" Then
             
            d = DateDiff("d", Date, vDat)
             
               Select Case True
                  Case vDat > Date
                        bIsDirty = True
                        ActiveCell.Offset(0, iOff).Interior.Color = vbRed
                        If ActiveCell.Offset(0, kiCellMsg).Value = "" Then ActiveCell.Offset(0, kiCellMsg).Value = "Past Due"
                        'msgbox "Past Due"
                       
                  Case vDat <= Date
                     bAlert = DateDiff("d", vDat, Date) < 10
                        If bAlert Then
                           bIsDirty = True
                           vMsg = "upcoming expiration date in " & Abs(d) & " days"
                           ActiveCell.Offset(0, kiCellMsg).Value = vMsg
                           ActiveCell.Offset(0, iOff).Interior.Color = vbYellow
                           'msgbox vMsg
                        Else
                           If Not bIsDirty Then ActiveCell.Offset(0, kiCellMsg).Value = ""
                           ActiveCell.Offset(0, iOff).Interior.Color = vbWhite
                        End If
                     
                End Select
        Else
            If Not bIsDirty Then ActiveCell.Offset(0, kiCellMsg).Value = ""
            ActiveCell.Offset(0, iOff).Interior.Color = vbWhite
        End If
     
      'End If
  Next
 
  ActiveCell.Offset(1, 0).Select  'next row
Wend
End Sub

 

[user8314]

Thanks for the code. It colorized the cells but had no message box for the offending cells. I currently have a colorizing system setup with conditional formatting, but would like it be a pop-up right when opening this worksheet. I don't believe it would get too busy as most of the expiration dates are spread apart.