I have an Excel sheet that sends an email to people depending on their certification date.
Example of what this should look like.
It has been requested that if someone is listed with no certifications, they are sent an email to become certified or be taken off the list. I thought I figured out a solution.
Sub AutoMailerFinalSheet3()
Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")
Dim EItem As Object
Dim RList As Range
Set RList = Range("C5", "BZ57")
Dim R As Range
Dim emptyCount As Integer
Dim Password As Variant
Dim sBodyOne As String
Dim sBodyTwo As String
Dim sWarnOne As String
Dim sWarnTwo As String
Dim RNames As Range, RName As Range
Set RNames = Range("C2", "P2")
Dim sOverdue As String
Password = Application.InputBox("Enter Password", "Password Protected")
Select Case Password
Case Is = False
'
Case Is = "PPQE"
emptyCount = 0
For Each RName In RNames
If isEmpty(RName) = False Then
sOverdue = "due"
For Each R In Intersect(RList, RName.EntireColumn)
If isEmpty(R) = False Then
If (DateDiff("d", R.Value, Now)) >= 335 And (DateDiff("d", R.Value, Now)) < 365 Then
R.Interior.ColorIndex = 27
sBodyOne = sBodyOne & vbNewLine & _
R.Offset(0, (-(R.Column - 1))) & ". You have " & (365 - (DateDiff("d", R.Value, Now))) & " days until it expires."
sWarnOne = vbNewLine & vbNewLine & "You are nearing expiration for the following equipment:" & vbNewLine
ElseIf (DateDiff("d", R.Value, Now)) > 365 Then
If (DateDiff("d", R.Value, Now)) > 425 Then
R.Interior.ColorIndex = 1 ]
sOverdue = "overdue" 'Change message to overdue
sBodyTwo = sBodyTwo & vbNewLine & _
R.Offset(0, (-(R.Column - 1))) & ". You are " & ((DateDiff("d", R.Value, Now)) - 365) & " days overdue for retraining."
sWarnTwo = vbNewLine & vbNewLine & "Your certification has expired with the following equipment:" & vbNewLine
Else
R.Interior.ColorIndex = 3
sOverdue = "overdue"
sBodyTwo = sBodyTwo & vbNewLine & _
R.Offset(0, (-(R.Column - 1))) & ". You are " & ((DateDiff("d", R.Value, Now)) - 365) & " days overdue for retraining. You have " & (Abs((DateDiff("d", R.Value, Now)) - 425)) & " days before a full retraining is required."
sWarnTwo = vbNewLine & vbNewLine & "Your certification has expired with the following equipment:" & vbNewLine
End If
ElseIf (DateDiff("d", R.Value, Now)) < 335 Then
R.Interior.ColorIndex = 10
End If
ElseIf isEmpty(R) = True Then
emptyCount = emptyCount + 1 'This counts every empty box, or cells without any certification
End If
Next
End If
If Not sBodyOne = "" Or Not sBodyTwo = "" Then
Set EItem = EApp.CreateItem(0)
With EItem
.To = RName.Offset(1, 0)
.Subject = "You're " & sOverdue & " for retraining and certification"
.body = "Hello, " & RName & vbNewLine & "This email is to remind you that your certification with Pilot Plant equipment is close to expiring, or has already expired." & sWarnOne & sBodyOne & sWarnTwo & sBodyTwo & vbNewLine & vbNewLine & "Contact ] for retraining."
.Display
End With
ElseIf emptyCount = 53 Then 'There are 53 pieces of equipment, so if they are all blank and there are no certification records, then it should send this email.
Set EItem = EApp.CreateItem(0)
With EItem
.To = RName.Offset(1, 0)
.Subject = "You are listed as an operator but have no certifications"
.body = "Hello, " & RName & vbNewLine & "You have been sent this email because you are listed as an operator, yet have no certifications with any equipment. Please reach out to schedule training, or to be removed from the operator list."
End With
End If
If emptyCount > 0 Then
MsgBox (emptyCount) 'My attempt at debugging and seeing the values.
End If
sBodyOne = vbNullString
sBodyTwo = vbNullString
sWarnOne = vbNullString
sWarnTwo = vbNullString
Next RName
Set EApp = Nothing
Set EItem = Nothing
Case Else
MsgBox "Incorrect Password"
End Select
End Sub
My solution is to count every empty box in the loop, adding 1 to a variable. When it reaches the end of the loop, if that variable is equal to 53 (the number of machines), then it should trigger that "If" statement and send, but it doesn't trigger. It still triggers normally for the ones that aren't empty.
I set up a text box that displays the variable's value, and it confirms that it properly counts to 53 for people who are completely uncertified, but the "If" statement doesn't trigger.
In the attached example screenshot, the code would count every blank cell under an operator's name, and compare it to the number of equipment there are. In this case, since Ally has 10 blank cells, and there are 10 machines, then the condition is met, and the email should trigger.
