Questions VBA code to create message box pop up for expiry dates

[Wolfie82]

Hi, I have a list of Equipment description under B4 to B195 and expiring calibration due date which is in M4 to M195.

I wanted to have a msgbox popup message which shows the list of Equipment and dates which are 30 days near expiring.

Would appreciate if anyone could help.

 

[Joe4]

Welcome to the Board!

Why not just use a Filter?
Or you could make use of the new dynamic spill FILTER function to return all the values meeting that criteria on another tab.
See: FILTER function - Microsoft Support

Or perhaps just use Conditional Formatting to dynamically highlight those rows?

You could use VBA/MsgBox, but will using those other options, VBA isn't necessary (and will probably look a bit nicer than an unformatted MsgBox anyway).
If you still really want to use VBA, it can be done. Just let us know.
Just answer the following questions regarding the dates in column M.
- Does every row have a date, or may some be blank?
- What do you want to happen with rows that have already expired (date in column M is in the past)? Should they be shown on this list?

 

[Wolfie82]

Welcome to the Board!

Why not just use a Filter?
Or you could make use of the new dynamic spill FILTER function to return all the values meeting that criteria on another tab.
See: FILTER function - Microsoft Support

Or perhaps just use Conditional Formatting to dynamically highlight those rows?

You could use VBA/MsgBox, but will using those other options, VBA isn't necessary (and will probably look a bit nicer than an unformatted MsgBox anyway).
If you still really want to use VBA, it can be done. Just let us know.
Just answer the following questions regarding the dates in column M.
- Does every row have a date, or may some be blank?
- What do you want to happen with rows that have already expired (date in column M is in the past)? Should they be shown on this list?

Hi Joe,

Thanks for the reply. I already have conditional formatting to highlight those expiring in 30 days in red and 60 days in yellow.

As there are too many equipment to keep track it would be nice to have a pop up message to show which are the item which are going to expired soon to serve as a reminder everytime I open the excel sheet.

 

[Joe4]

Hi Joe,

Thanks for the reply. I already have conditional formatting to highlight those expiring in 30 days in red and 60 days in yellow.

As there are too many equipment to keep track it would be nice to have a pop up message to show which are the item which are going to expired soon to serve as a reminder everytime I open the excel sheet.

Please answer the two questions at the bottom of my previous reply.

Also, answer the following questions:
- Do you want this to happen automatically, when the workbook is opened?
- If there are multiple sheets in your workbook, what is the name of the sheet where this data resides?

 

[Joe4]

Assuming that you want this to happen automatically, and are only concerned with future dates within the next 30 days, place this code in the "ThisWorkbook" module in VBA (it MUST be in this particular module if you want it to run automatically upon opening the file):

Private Sub Workbook_Open()

    Dim cell As Range
    Dim fnd As Boolean
    Dim msg As String

'***ENTER NAME OF SHEET WITH DATA HERE***
    Sheets("Sheet1").Activate
    
'   Set initial values
    fnd = False
    msg = "Equipment with expiration dates within next 30 days:" & vbCrLf
    
'   Loop through all cells
    For Each cell In Range("M4:M195")
'       Check to see if future date in column M
        If cell.Value > 0 And cell.Value >= Date Then
'           Check to see if date is within next 30 days
            If cell.Value - Date <= 30 Then
                fnd = True
'               Add value from column B to string
                msg = msg & cell.Offset(0, -11) & vbCrLf
            End If
        End If
    Next cell
    
'   Return message
    If fnd Then
        MsgBox msg
    Else
        MsgBox "No equipment with expiration dates in the next 30 days."
    End If
    
End Sub

Note the lines near the top that looks like this:

'***ENTER NAME OF SHEET WITH DATA HERE***
    Sheets("Sheet1").Activate

If the name of the sheet with data is anything other than "Sheet1", change the name of that sheet to match what you have.

This should now run automatically when you open the file. If it does not find any matching dates, it will tell you.
So as long as you have VBA enabled, you will ALWAYS get a message whenever you open the file.

 

[Wolfie82]

Please answer the two questions at the bottom of my previous reply.

Also, answer the following questions:
- Do you want this to happen automatically, when the workbook is opened?
- If there are multiple sheets in your workbook, what is the name of the sheet where this data resides?

Yes. I want this to happen automatically when the workbook is open.

Yes there are multiple sheets. The data is on sheet4(CALList)

 

[Joe4]

Yes. I want this to happen automatically when the workbook is open.

Yes there are multiple sheets. The data is on sheet4(CALList)

Seem to be a few posts behind...

Take a look at my last post. You will just need to change the sheet name, like I instructed.

 

[Wolfie82]

Seem to be a few posts behind...

Take a look at my last post. You will just need to change the sheet name, like I instructed.

Thank you Joe for the code. I will try this in the next the few days.

 

[Wolfie82]

Assuming that you want this to happen automatically, and are only concerned with future dates within the next 30 days, place this code in the "ThisWorkbook" module in VBA (it MUST be in this particular module if you want it to run automatically upon opening the file):

Private Sub Workbook_Open()

    Dim cell As Range
    Dim fnd As Boolean
    Dim msg As String

'***ENTER NAME OF SHEET WITH DATA HERE***
    Sheets("Sheet1").Activate
   
'   Set initial values
    fnd = False
    msg = "Equipment with expiration dates within next 30 days:" & vbCrLf
   
'   Loop through all cells
    For Each cell In Range("M4:M195")
'       Check to see if future date in column M
        If cell.Value > 0 And cell.Value >= Date Then
'           Check to see if date is within next 30 days
            If cell.Value - Date <= 30 Then
                fnd = True
'               Add value from column B to string
                msg = msg & cell.Offset(0, -11) & vbCrLf
            End If
        End If
    Next cell
   
'   Return message
    If fnd Then
        MsgBox msg
    Else
        MsgBox "No equipment with expiration dates in the next 30 days."
    End If
   
End Sub

Note the lines near the top that looks like this:

'***ENTER NAME OF SHEET WITH DATA HERE***
    Sheets("Sheet1").Activate

If the name of the sheet with data is anything other than "Sheet1", change the name of that sheet to match what you have.

This should now run automatically when you open the file. If it does not find any matching dates, it will tell you.
So as long as you have VBA enabled, you will ALWAYS get a message whenever you open the file.

Hi Joe,

Good Day to you. I have tried the code but it prompt me with the following error code.

 

[Joe4]

Move the code out to another procedure you can run manually, i.e.

Sub MyTest()
'   the body of all your code here
End Sub

Then step into that code and run it one step at a time, using the F8 key, and see where the error occurs.