I am building an LOP (List of Open Points) in Excel 2016 for a manufacturing project. Each action item will have a ‘target date’ for completion. My intention is every time the document is opened, a macro will run that will scan the document and every item that is past due, comparing the ‘target date’ to today’s date, will trigger a MsgBox popup that states “There are past due items in the following row(s): X, Y, and Z.” I have ran into two issues that I’m trying to resolve:
The range of cells for the ‘target date’ column (J) will not yield a result. It will display the MsgBox if I enter a single cell. For example, if I only put the range as J4, and J4 is past due, the MsgBox will display as intended. But, if I set the range as “J4:J999” with multiple entries past due in the J column and run it, it does nothing, not even give me an error.
I cannot figure out how to integrate the date comparison code into a multiple-output MsgBox code. Maybe once the range issue is resolved, it will help.
Below is the code I’m using to identify the past due cells in the J column and yield the MsgBox:
Private Sub Workbook_Open() Dim cl As Range Set cl = ThisWorkbook.Sheets("OPEN ITEMS").Range("J4:J999") If IsDate(cl) Then If Now >= cl Then MsgBox "There are past due items in the following row(s):" & "" & cl.Address, vbExclamation, "ACTION REQUIRED" End If End If End Sub
Any help would be greatly appreciated.
Try this code:
EDIT: As per BigBen’s comment, added control if no rows met the condition. (Thnx @BigBen)
Private Sub Workbook_Open() Dim evalRange As Range Dim evalCell As Range Dim resultRows As String Set evalRange = ThisWorkbook.Sheets("OPEN ITEMS").Range("J4:J999") For Each evalCell In evalRange If IsDate(evalCell) Then If Now >= evalCell Then resultRows = resultRows & evalCell.Row & "," End If End If Next evalCell If resultRows <> vbNullString Then ' Remove last comma resultRows = Left$(resultRows, Len(resultRows) - 1) MsgBox "There are past due items in the following row(s):" & resultRows, vbExclamation, "ACTION REQUIRED" End If End Sub
One way is to create a loop over an array (probably prefered) but let me show you a way without any iteration:
Private Sub Workbook_Open() Dim lr As Long Dim arr As Variant Dim rng As Range With ThisWorkbook.Sheets("OPEN ITEMS") 'Get last used row and create a range object lr = .Cells(.Rows.Count, 10).End(xlUp).Row Set rng = .Range("J4:J" & lr) 'Get data into array arr = Filter(.Evaluate("TRANSPOSE(IF(" & rng.Address & ">=NOW(),ROW(" & rng.Address & "),""|""))"), "|", False) 'Use array in any message you like MsgBox "There are past due items in the following row(s): " & Join(arr, ",") End With End Sub
Allthough this bypasses the need for any iteration, it does however make use of an array formula which on large data does slow things down (a 1000 rows isn’t that much though).
Note: Keep in mind that the max amount of characters in a Msgbox prompt is approximately 1024.
I just tried this code on about 1000 lines all past due data, and allthough it was still fast, about half of them won’t show in the messagebox!