VBA pop-up reminder for date column

[user294390]

Hi,

I am compiling a database and require pop-up alerts for one date column. My spreadsheet is like this:
Column A - vendor name
Column B - expiry date of subscription
and several columns beyond, with other details like address, products etc.

I am trying to add a message box alert 7 days before the date as well as on that date, showing "Subscriptions expiring in 7 days for <corresponding vendor names in column A>"
or "Subscriptions expiring today for <corresponding vendor names in column A>" according to the date.
Would appreciate any help with this, thank you!

 

[mart37]

Put this macro in ThisWorkbook:

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim rVendor As Range
    Dim rEdate As Range
    Dim lLastrow As Long, i As Long
    Set ws = Worksheets("Sheet1") 'name of sheet with data
    lLastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    With ws
        For i = 2 To lLastrow
            If .Cells(i, 2) = Date + 7 Then MsgBox ("Subscriptions expiring in 7 days for " & .Cells(i, 1))
            If .Cells(i, 2) = Date Then MsgBox ("Subscriptions expiring today for " & .Cells(i, 1))
        Next
    End With
End Sub

 

[user294390]

Put this macro in ThisWorkbook:

Private Sub Workbook_Open()
    Dim ws As Worksheet
    Dim rVendor As Range
    Dim rEdate As Range
    Dim lLastrow As Long, i As Long
    Set ws = Worksheets("Sheet1") 'name of sheet with data
    lLastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    With ws
        For i = 2 To lLastrow
            If .Cells(i, 2) = Date + 7 Then MsgBox ("Subscriptions expiring in 7 days for " & .Cells(i, 1))
            If .Cells(i, 2) = Date Then MsgBox ("Subscriptions expiring today for " & .Cells(i, 1))
        Next
    End With
End Sub

Thank you so much! It works perfectly.

 

[user294390]

Hi, how to I get the code to run automatically every time I open the sheet? Sometimes it works but otherwise I have to manually run the code to view the pop-ups

 

[Yongle]

The code would be expected to run whenever the workbook is opened UNLESS macros or events are disabled
The problem may originate outside this workbook
Is another workbook open at the time when the popup fails to appear?

 

[user294390]

The code would be expected to run whenever the workbook is opened UNLESS macros or events are disabled
The problem may originate outside this workbook
Is another workbook open at the time when the popup fails to appear?

Initially macros were disabled with notification, I changed it to enable all macros (very reluctantly, since I usually download a lot of files from the internet) but it didn't work every time. No other workbook was open
What are events?

 

[Yongle]

The macro iteself is an event macro because it is triggered when an "event" occurs - the event being opening the workbook.
We could change the trigger so that the macro runs when you activate the sheet rather than opening the workbook
Let me know if you would prefer that and I will explain the steps you need to take

 

[user294390]

Sure, either way is fine for me but since the workbook trigger isn't working we can try it when the sheet is activated instead

 

[Yongle]

I have amended the macro to group messages together if more than one row throws an alert


1. Delete Wokbook_Open procedure

2. Place code below in the SHEET code window for sheet1
(right click on sheet name tab \ view code \paste it into the open window)

Private Sub Worksheet_Activate()
    Dim rVendor As Range, rEdate As Range, Msg1 As String, Msg2 As String
    Dim lLastrow As Long, i As Long
    Const m1 = "Subscriptions expiring in 7 days for "
    Const m2 = "Subscriptions expiring today for "
  
    lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lLastrow
        If Cells(i, 2) = Date + 7 Then Msg1 = Msg1 & vbCr & Cells(i, 1)
        If Cells(i, 2) = Date Then Msg2 = Msg2 & vbCr & Cells(i, 1)
    Next
    If Len(Msg1) > 0 Then MsgBox m1 & vbCr & Msg1, , ""
    If Len(Msg2) > 0 Then MsgBox m2 & vbCr & Msg2, , ""
End Sub

Does your workbook contain another sheet?
- if it doesn't ... insert another sheet and name it "Landing"

Activate a different sheet and then click on sheet1 to trigger the macro

We will add a bit more code after you have got the above working so that it runs when the workbook is opened without using Workbook_Open

 

[user294390]

I have amended the macro to group messages together if more than one row throws an alert


1. Delete Wokbook_Open procedure

2. Place code below in the SHEET code window for sheet1
(right click on sheet name tab \ view code \paste it into the open window)

Private Sub Worksheet_Activate()
    Dim rVendor As Range, rEdate As Range, Msg1 As String, Msg2 As String
    Dim lLastrow As Long, i As Long
    Const m1 = "Subscriptions expiring in 7 days for "
    Const m2 = "Subscriptions expiring today for "
 
    lLastrow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lLastrow
        If Cells(i, 2) = Date + 7 Then Msg1 = Msg1 & vbCr & Cells(i, 1)
        If Cells(i, 2) = Date Then Msg2 = Msg2 & vbCr & Cells(i, 1)
    Next
    If Len(Msg1) > 0 Then MsgBox m1 & vbCr & Msg1, , ""
    If Len(Msg2) > 0 Then MsgBox m2 & vbCr & Msg2, , ""
End Sub

Does your workbook contain another sheet?
- if it doesn't ... insert another sheet and name it "Landing"

Activate a different sheet and then click on sheet1 to trigger the macro

We will add a bit more code after you have got the above working so that it runs when the workbook is opened without using Workbook_Open

Done, as you said it works when I switch from Landing to Sheet 1