VBA - Pop alert for list of dates

PT_ANCF

New Member
Joined
Mar 18, 2019
Messages
13
Hello all,


First of all, I tried to find a similar thread but without much success (as I'm new) for my question. So sorry, if there is already a similar thread and if yes and you have it, just point me to the right direction. Thank you.


So I have a list of client contracts and I would like to have a pop-alert running through VBA that would give me an alert. For example:


Untitled.png





In this case, I would like for a pop up tab to appear with the clients that, in column E, are -3 months from the End date (column D) with a message like "Renewal meeting with Client(s) x and y" e.g.


I have the idea that it's possible as I've seen it for one single cell but I would like the alert to catch all the contracts that are -3months. Is this possible?


Thank you so much for the aid.


Best regards,
PT_ANCF
 

Excel Facts

How to calculate loan payments in Excel?
Use the PMT function: =PMT(5%/12,60,-25000) is for a $25,000 loan, 5% annual interest, 60 month loan.
I was trying to change the starting range for D19 instead of D1 for the end date but I'm messing to much with the code :S (really waiting for my vba classes).

Any suggestion? Same idea just starting to read the End date (column D) in another row (in this case "19"),

Thanks again
 
Upvote 0
My script did just what your image showed.
Your image seems to say start looking on D2

But if you want to start on D19 change this line of code:

For i = Lastrow To 2 Step -1

To:

For i = Lastrow To 19 Step -1
 
Last edited:
Upvote 0
Yes, I just added some extra lines to my document.

Thank you for the patience and explication.

This helped me a lot to finish a contract project I had.
 
Upvote 0
In case your still here:

I always prefer to use a TextBox to display Data on the screen instead of Message Box.
This way the data can stay visible when script ends.

Try this new script:

A Shape TextBox will have the Data you want:

To delete the shape after viewing just press Delete Key if you still have shape selected.
Or select shape and then click delete key

Code:
Sub Date_New()
'Modified  3/20/2019  8:59:40 PM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim n As String
Dim nn As String
Lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For i = Lastrow To 19 Step -1
    
    If Cells(i, 4).Value <= Date + 90 And Cells(i, "I").Value <> "X" Then
            n = vbNewLine & Cells(i, 1).Value & n
    End If
Next
If n <> "" Then
    nn = "Renewal alert, clients:"
Else
nn = "None Found"
End If
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 435, 90.75, 177.75, 102).Select
    Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 255, 0)
    Selection.Left = Range("G3").Left
    Selection.Top = Range("G3").Top
    ShapeName = Selection.Name
    
   
    With Selection.ShapeRange.TextFrame2
        .TextRange.Font.Size = 16
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = nn & vbNewLine & n
        .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 255)
        .TextRange.Font.Bold = True
        .AutoSize = msoAutoSizeShapeToFitText
    End With
    
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here is another one with a nicer looking Shape.
Assuming your version of Excel has this shape

Us Excel Geeks like making new things:
Code:
Sub Date_New()
'Modified  3/21/2019  4:43:51 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim n As String
Dim nn As String
Lastrow = Cells(Rows.Count, "D").End(xlUp).Row
For i = Lastrow To 19 Step -1
    
    If Cells(i, 4).Value <= Date + 90 And Cells(i, "I").Value <> "X" Then
            n = vbNewLine & Cells(i, 1).Value & n
    End If
Next
If n <> "" Then
    nn = "Renewal alert, clients:"
Else
nn = "None Found"
End If
ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 435, 90.75, 177.75, 102).Select
     Selection.Left = Range("G3").Left
    Selection.Top = Range("G3").Top
    ShapeName = Selection.Name
 
 Selection.ShapeRange.ShapeStyle = msoShapeStylePreset27
    With Selection.ShapeRange.ThreeD
        .BevelTopType = msoBevelSoftRound
        .BevelTopInset = 12
        .BevelTopDepth = 4
    End With
 
 
     With Selection.ShapeRange.TextFrame2
        .TextRange.Font.Size = 16
        .TextRange.ParagraphFormat.Alignment = msoAlignCenter
        .TextRange.Characters.Text = nn & n
        .TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
        .TextRange.Font.Bold = True
        .AutoSize = msoAutoSizeShapeToFitText
    End With
    
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top