VBA Code to Alert Against Expired Material Assistance - vba

Question

I am trying to create a popup window as soon as I open my excel file.
The excel workbook that I have has multiple sheets.
One of the sheets is titled "Inventory".
As shown in the image below, there is a column in the Inventory tab that is titled "Days Until Expiration".
I want to have my excel file display a pop up when opening the workbook. This popup will check the "Days Until Expiration" column in the "Inventory" tab and say something like "____ material" (from the 'Type' Column) "has ____" days until expiration.
This will only happen if the "Days Until Expiration" value is in between 0 and 14 days.
If the number is negative in the "Days Until Expiration" column, I want the message pop up to say "___ material has expired".
Shown below is what I have so far. I have created a workbook_open() event and this code is in my "ThisWorkbook" code tab.
I am also getting an error when I run what I have below, specifically saying:
Run-time error '13': Type mismatch
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim wb As Workbook
Dim ws As Worksheet
Dim rngUsed As Range, rngExpirationColumn As Range, rngCell As Range
Dim strExpirationMessage As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("Inventory")
Set rngUsed = ws.UsedRange
Set rngExpirationColumn = Intersect(ws.Columns(4), rngUsed)
For Each rngCell In rngExpirationColumn.Cells
If Date - CDate(rngCell.Value2) >= 14 Then
If Len(strExpirationMessage) = 0 Then
strExpirationMessage = rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration"
Else
strExpirationMessage = strExpirationMessage & Chr(13) & rngCell.Offset(0, -3).Value2 & " material has " & (Date - CDate(rngCell.Value2)) & " days left before expiration"
End If
End If
Next
MsgBox strExpirationMessage
End Sub

Answer 1

I'm posting this answer based on your request and with some assumptions, as follows:
You want to check the data for column "Days Until Expiration" (as per your request)
You want to grab the data from column "Type" to add on the popup (as per your request)
You want one message if the Expiration Days is between 0 and 14
You want another message if the Expiration Days is less than 0
The value on column "Days Until Expiration" is actually a number (this is an assumption, since no data was provided)
I'm assuming "Days Until Expiration" is merged into two rows (per screenshot)
I'm assuming your data is directly below the rows from your screenshot, so probably your actual data starts on Row 4
Here is the code (tested based on assumptions above, due to lack of actual data to reproduce the scenario):
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim ws As Worksheet
Dim strExpirationMessage As String
Dim rngExpirationCell As Range, rngTypeCell As Range
Dim lngRow As Long, lngExpirationCol As Long, lngTypeCol As Long
Set ws = ThisWorkbook.Worksheets("Inventory")
Set rngExpirationCell = ws.UsedRange.Find(What:="Days Until Expiration", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
Set rngTypeCell = ws.UsedRange.Find(What:="Type", LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not rngExpirationCell Is Nothing And Not rngTypeCell Is Nothing Then
lngExpirationCol = rngExpirationCell.Column
lngTypeCol = rngTypeCell.Column
For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
With ws.Cells(lngRow, lngExpirationCol)
If 0 <= .Value And .Value <= 14 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
ElseIf .Value < 0 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
End If
End With
Next
strExpirationMessage = Left(strExpirationMessage, Len(strExpirationMessage) - 2) 'to remove trailing vbCrLf
MsgBox strExpirationMessage
End If
End Sub
Important Notes:
I've modified part of your logic, by eliminating some variables and using others instead.
I'm not working with range objects, but rather with specified cells
I'm performing a dynamic search for the desired Columns "Days Until Expiration" and "Type", instead of working with fixed column and with offsets, to allow you to change the columns position in future without changing the code.
I'm assuming "Days Until Expiration" is merged into two rows (per screenshot) and this is why I'm using rngExpirationCell.row + 2 in the For loop. If you have anything different than that, the code might need changes.
I hope this suits your needs. Let me know of any issues or concerns.
If this post answers your question, please Accept it by clicking on the Check mark on the left of it.
Update:
Based on the issues you found, below are two alternate solutions for the For loop that you could use. Everything else should be exactly the same. Just replace the For loop with either of the logic below and you should be good to go
Assuming you want to leave the logic once you found an Empty cell:
For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
With ws.Cells(lngRow, lngExpirationCol)
If IsEmpty(.Value) Then Exit For 'Will leave the For loop once an Empty cell is found
If 0 <= .Value And .Value <= 14 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
ElseIf .Value < 0 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
End If
End With
Next
Assuming you want to skip the evaluation for the Empty cells, but continue checking the cells until the end of the Used Range:
For lngRow = rngExpirationCell.row + 2 To ws.UsedRange.Rows.Count
With ws.Cells(lngRow, lngExpirationCol)
If Not IsEmpty(.Value) Then 'Will skip empty cells but continuing validation until the end of the Used Range
If 0 <= .Value And .Value <= 14 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has " & .Value & " days left before expiration" & vbCrLf
ElseIf .Value < 0 Then
strExpirationMessage = strExpirationMessage & ws.Cells(lngRow, lngTypeCol).Value & " material has expired" & vbCrLf
End If
End If
End With
Next