VBA code for "pop-up” message in VBA warning for due dates

[curious_Tanya]

Hello community,

I have a question and wondered if someone can help me with it.
I have Excel file with multiple tabs (with different loans and their maturity dates). I want to set up “pop-up” message in VBA warning me when due date in column “R” (always this column in each tab) is getting close to maturity date (7 calendar days) before. Something like “Attention, one of the loans is expiring within 7 days, please check!”.

Could someone please help with VBA code for this? I am struggling for a while now without success. Many, many thanks in advance!

 

[sykes]

Hi, and welcome to Mr. Excel!

Are there more than one date to check in column R, on each worksheet? If so, where do the dates in column R start, and end?

 

[curious_Tanya]

Hello Sykes,

thanks for welcoming words!
Yes - there are more dates in the column R on each worksheet. Lets say the data range is "R14:R500"...some worksheets are shorter/some longer but maximum is 500.

 

[sykes]

You'll need to paste this code into each sheet's "Worksheet_Activate" event, so that it runs whenever the sheet's activated:

Private Sub Worksheet_Activate()
Dim cl As Range
Dim rng As Range
Dim str As String

Set rng = Me.Range("R14:R500")
On Error GoTo exit_sub
For Each cl In rng
    If cl.Value = "" Then GoTo Next_cl
 If cl.Value < Date + 8 Then Debug.Print cl.Address: str = str & Chr(10) & cl.Row
 
Next_cl:
Next

MsgBox "Attention, one of the loans is expiring within 7 days, please check the following rows!: " & Chr(10) & str, 48, "Expiring loans!"
exit_sub:
End Sub

There are many different ways of doing this, but just to get you going - to see if it's the kind of thing you want - I've just hard-coded R14:R500 as the range to be searched.

Do you know how to get this into the right place, to run it automatically, or would you like some guidance?

 

[curious_Tanya]

HI Sykes,

yes, this is indeed good start.
- I copied it into each sheet but is it possible to use it in "Private Sub Workbook_Activate()"? To copy once for full workbook? I tried to copy into "Thisworkbook", but it gives me error message "compile error: Method or data member not found...
- I see the message "Attention..." when I hit "Continue (F5)" button but not automatically upon opening of the file. Do you know how to run it upon opening of the file each time?
- message "please check the following rows!: " implies row indication but it does not say which row to look at. Is this code programmed to show exact row? It would be nice...but I dont expect it, as long as I get notification at all or maybe concerned tab.

 

[sykes]

This needs to go into the "Thisworkbook" module:

Private Sub Workbook_Open()

Dim cl As Range
Dim rng As Range
Dim str As String
Dim sht_str As String
Dim sht As Worksheet

 sht_str = "Attention! The following loans expire within 7 days, or have already expired: " & Chr(10) & Chr(10)

    For Each sht In Me.Worksheets
        sht_str = sht_str & sht.Name & ":"
        str = ""
    Set rng = sht.Range("R14:R500")
    On Error GoTo exit_sub
        For Each cl In rng
            If cl.Value = "" Then GoTo Next_cl
         If cl.Value < Date + 8 Then  str = str & Chr(10) & "Row " & cl.Row
         
Next_cl:
        Next cl
            If str = "" Then str = Chr(10) & "No loans expiring on this sheet"
        sht_str = sht_str & str & Chr(10) & Chr(10)
    Next sht
MsgBox sht_str, 48, "Expiring loans!"
exit_sub:
End Sub

The main concern I would have, is that the message box would get too big, if there are too many sheets, with too many expiring loans on them.
Give it a go, and see what you think, anyway....

 

[sykes]

Hi. Did this do the trick for you?

 

[sykes]

Hello? Anyone there?

 

[curious_Tanya]

Hello Sykes,

thank you for checking...I went on holidays and forgot all about my Excel troubles
But now i am back to work and again look at the same file.
Your programming text is very good - I must say thank you again...Its 99% of what I look for. Just one question:

" If cl.Value < Date + 8 Then str = str & Chr(10) & "Row " & cl.Row" this sentence is showing all dates after today's date plus next 8 days, right?
So, I see a lot of columns indication (with old dates going years back). Actually, as I am checking this file once per week it sufficient to see 5 days before today and 8 days after today's date.
Do you maybe know who to change this? Something like "< Date + 8 & > Date - 5"
Does it make sense?
Many, many thanks

 

[sykes]

Private Sub Workbook_Open()

Dim cl As Range
Dim rng As Range
Dim str As String
Dim sht_str As String
Dim sht As Worksheet

 sht_str = "Attention! The following loans expire within 7 days, or have already expired: " & Chr(10) & Chr(10)

    For Each sht In Me.Worksheets
        sht_str = sht_str & sht.Name & ":"
        str = ""
    Set rng = sht.Range("R14:R500")
    On Error GoTo exit_sub
        For Each cl In rng
            If cl.Value = "" Then GoTo Next_cl
         If cl.Value < Date + 8 AND cl.Value > Date -5  Then  str = str & Chr(10) & "Row " & cl.Row
         
Next_cl:
        Next cl
            If str = "" Then str = Chr(10) & "No loans expiring on this sheet"
        sht_str = sht_str & str & Chr(10) & Chr(10)
    Next sht
MsgBox sht_str, 48, "Expiring loans!"
exit_sub:
End Sub

... You can adjust Date - 8, Date + 5 etc to suit your exact requirements.