Automatically send email when cell is left blank for 10 days

[Creativeboy4]

Hey all!
I am new with Microsoft Visual Basis. The idea is to have a automatically sent email when the cell is left blank for 10 days.

The workbook looks like this:

: So the value at cell N5 is 26-Sep, If the person do not add a letter X to the cell N6 in 10 days, then there is a automaticall email sended.

Could you please help me to get this figured out and how to write the code?

All best,

Creativeboy4

 

[cmowla]

Hi! Welcome to Mr. Excel. (I'm new here too!)

Five questions: (Once these are answered, either I or someone else who can do this for you can.)

1. I assume that you wish to send (are able to send) emails with Microsoft Outlook (and you have an Outlook account set up already), correct?
2. In your example, when you said if the letter X is not added to the cell N6, did you mean cell O5 (the cell to the right of 26-Sept under the heading Received (Date and TLC)), or did you mean cell N6?
3. When you say 10 days, is that 10 days from September 26 or 10 days from when September 26 (or anything other than an X) was last typed in the cell?
4. And when you say "days", do you mean 365 calendar days, or business days (where national (and local/special) holidays are taken into consideration?
5. Are you formatting the cell where the date (such as 26-Sept) as Date, or just as Text, Custom, or general? (Select the cell and press Ctrl 1 and click the Number tab to the left to see.)

 

[Logit]

The following utilizes cell Z1 as a Date Placement Holder. Z1 must not be edited once the date in N5 has been entered.
Any cell can be used for this purpose so long as the macro is edited to match.

The following should be pasted into a Regular Module :

Option Explicit

Sub chkdate()
Dim n As String
Dim Today As Long

n = Sheets("Sheet1").Range("Z1").Value

    If Sheets("Sheet1").Range("N5").Value = "X" Or Sheets("Sheet1").Range("N5").Value = "x" Then Exit Sub
        
    If n < (Now() - 10) Then
        Send_Mail_From_Excel
    End If

End Sub


Sub Send_Mail_From_Excel()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
 
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
 
    'Send Mass Email Using Excel VBA Macro Code
    With OutlookMail
        .to = "youremail@some.com"
        .CC = ""
        .BCC = ""
        .Subject = "Exceeded 10 Time Limit"
        .Body = "Received Date & TLC not provided."
        
        '.Send  ' or just put .Send to directly send the mail instead of display
        .Display
        
    End With
 
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

This macro should be pasted into the ThisWorkbook Module :

Option Explicit

Private Sub Workbook_Open()
    chkdate
End Sub

 

[Creativeboy4]

Hi! Welcome to Mr. Excel. (I'm new here too!)

Five questions: (Once these are answered, either I or someone else who can do this for you can.)

1. I assume that you wish to send (are able to send) emails with Microsoft Outlook (and you have an Outlook account set up already), correct?
2. In your example, when you said if the letter X is not added to the cell N6, did you mean cell O5 (the cell to the right of 26-Sept under the heading Received (Date and TLC)), or did you mean cell N6?
3. When you say 10 days, is that 10 days from September 26 or 10 days from when September 26 (or anything other than an X) was last typed in the cell?
4. And when you say "days", do you mean 365 calendar days, or business days (where national (and local/special) holidays are taken into consideration?
5. Are you formatting the cell where the date (such as 26-Sept) as Date, or just as Text, Custom, or general? (Select the cell and press Ctrl 1 and click the Number tab to the left to see.)

1. Yes, I already have a account.
2.You are right, X goes in cell O5
3. Yes, 10 days from 26.September,starting from that date.
4. Days in this case means 365 days not business days.
5.I put the date as a calendar day.

Thank you for your reply

I hope we can find the answer,

All best,

Creativeboy4

 

[Creativeboy4]

The following utilizes cell Z1 as a Date Placement Holder. Z1 must not be edited once the date in N5 has been entered.
Any cell can be used for this purpose so long as the macro is edited to match.

The following should be pasted into a Regular Module :

Option Explicit

Sub chkdate()
Dim n As String
Dim Today As Long

n = Sheets("Sheet1").Range("Z1").Value

    If Sheets("Sheet1").Range("N5").Value = "X" Or Sheets("Sheet1").Range("N5").Value = "x" Then Exit Sub
       
    If n < (Now() - 10) Then
        Send_Mail_From_Excel
    End If

End Sub


Sub Send_Mail_From_Excel()
    Dim OutlookApp As Object
    Dim OutlookMail As Object
 
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
 
    'Send Mass Email Using Excel VBA Macro Code
    With OutlookMail
        .to = "youremail@some.com"
        .CC = ""
        .BCC = ""
        .Subject = "Exceeded 10 Time Limit"
        .Body = "Received Date & TLC not provided."
       
        '.Send  ' or just put .Send to directly send the mail instead of display
        .Display
       
    End With
 
    Set OutlookMail = Nothing
    Set OutlookApp = Nothing
End Sub

This macro should be pasted into the ThisWorkbook Module :

Option Explicit

Private Sub Workbook_Open()
    chkdate
End Sub

Just tried to paste your given code into the Visual basic. Now I am wondering if its already working?

All bests,

Creativeboy4

 

[Logit]

Download file : WORKS Check Date 10 Days Out.xlsm

To test the file, download the workbook above. The date in N5 is set at 9/21/21. When opening the workbook the
macro checks that date in N5 and finds it is within the time limit.

Change the date in N5 to 9/20/21 ... then click the button. The button is connected to macro. You will discover an
email is created because the date in N5 is outside of the time limit.

Your final workbook should not have the Command Button that runs the macro. The code located in the
ThisWorkbook module will automatically run the macro when the workbook is opened.

 

[cmowla]

@Creativeboy4 ,

I just did my version of what this project actually entails (including (but not limited to) considering that we have to take email notifications very seriously, and thus we cannot neglect subtle hindrances to receiving an email when we should). See the following video for an explanation of what the code does (and all that this project entails . . . at least at face value so far), as well as rigorous testing of functionality.

1. Save a copy of your Excel Workbook as either a .xlsb or .xlsm file extension (it can have the same name, just a different file extension).
2. Right click on the sheet tab name that you are showing in the picture (the tab name is in the bottom of the application window), select "View Code", and paste the following code inside.

(Note: When debugging this "email program", you will have to remove/comment the On Error GoTo Something_Went_Wrong line of code, first.)

Option Explicit

Private Sub Worksheet_Activate()

On Error GoTo Something_Went_Wrong
Call Test__Check_Date
Exit Sub
Something_Went_Wrong:
MsgBox "Something went wrong:", vbCritical, "Failed to check Date"

End Sub

Next, read (and follow) steps 1-4 of Insert and run VBA macros in Excel - step-by-step guide - Ablebits.com to be able to insert the following code into "Module1". (Or if you are not new to VBA, then whatever standar module you want.)

Option Explicit

Sub Test__Check_Date()
Call Check_Date("N", "O", "A", "T1", 5, 10, "Received date OVERDUE list for today [Microsoft Excel]")
End Sub
Sub Check_Date( _
requestedDate_ColumnLetter As String, _
toCheckIfEmpty_ColumnLetter As String, _
tagID_ColumnLetter As String, _
lastDateCheckedCellAddress As String, _
startRow As Long, _
numberOfDays As Integer, _
emailSubjectLine As String _
)

Dim todaysDate As Date
todaysDate = Date

'First check if emails were already sent today.
    Dim dateLastChecked As String
   
    Dim cellWithDateLastChecked As Range
    Set cellWithDateLastChecked = Range(lastDateCheckedCellAddress)
   
    cellWithDateLastChecked.Offset(0, -1).Value = "Last Chkd:"

    With cellWithDateLastChecked
        .Value = Trim(Remove_All_Non_Printing_Characters_Except_For_White_Spaces(.Value))
       
        If IsDate(.Value) = True Then
            .NumberFormat = "@"
            .Value = Day(.Value) & "-" & Month_Abbreviation(Month(.Value))
            dateLastChecked = .Value & " " & Year(Date)

            'We already sent the email for today.  Exit
            If CDate(dateLastChecked) >= todaysDate Then Exit Sub
        End If
    End With


'Now check the column for Tag No. IDs to send emails for if received date is OVERDUE.
    Dim lastRowWithData_In_RequestedDate_Column As Long
    lastRowWithData_In_RequestedDate_Column = Cells(Rows.Count, requestedDate_ColumnLetter).End(xlUp).Row
   
    Dim requestedDateColumn As Range
    Set requestedDateColumn = Range(requestedDate_ColumnLetter & startRow & ":" & requestedDate_ColumnLetter & lastRowWithData_In_RequestedDate_Column)
   
    Dim emailBody As String
    emailBody = "Recieved date OVERDUE for the following Tag No. IDs:" & "<br>"
   
    Dim requestedDate_In_CurrentRow As String
   
    Dim cell As Range
    For Each cell In requestedDateColumn
        With cell
            .Value = Trim(Remove_All_Non_Printing_Characters_Except_For_White_Spaces(.Value))
            If IsNumeric(.Value) = True Then
                .NumberFormat = "@"
                .Value = CDate(.Value)
            End If
            If IsDate(.Value) = True Then

                .NumberFormat = "@"
                .Value = Day(.Value) & "-" & Month_Abbreviation(Month(.Value))
                requestedDate_In_CurrentRow = .Value & " " & Year(Date)
                If (CDate(requestedDate_In_CurrentRow) + numberOfDays <= todaysDate) _
                   And _
                   Trim(Remove_All_Non_Printing_Characters_Except_For_White_Spaces(Range(toCheckIfEmpty_ColumnLetter & .Row).Value)) = "" _
                Then
                    emailBody = emailBody & "<br>" & "&bull; " & Range(tagID_ColumnLetter & .Row).Value & "   (Row " & .Row & ")"
                End If
            End If
        End With
    Next cell

'If indeed we have to send an email (there is AT LEAST one Tag No. ID OVERDUE), Then send the email.
If emailBody <> "Recieved date OVERDUE for the following Tag No. IDs:" & "<br>" Then Call Send_Mail_From_Excel2(emailSubjectLine, emailBody)

'And mark it that we sent the email for today so the email doesn't get sent more than once per day!
Range(lastDateCheckedCellAddress).Value = Day(todaysDate) & "-" & Month_Abbreviation(Month(todaysDate))


End Sub


Sub Test__Remove_All_Non_Printing_Characters_Except_For_White_Spaces()
Debug.Print Remove_All_Non_Printing_Characters_Except_For_White_Spaces(Chr(8) & "  " & Chr(10) & "AA" & Chr(10) & "BE" & " ")
End Sub
Function Remove_All_Non_Printing_Characters_Except_For_White_Spaces(str As String)
'Important note from:  https://docs.microsoft.com/en-us/office/vba/api/excel.worksheetfunction.clean
'The Clean function was designed to remove the first 32 nonprinting characters
'in the 7-bit ASCII code (values 0 through 31) from text. In the Unicode character set,
'there are additional nonprinting characters (values 127, 129, 141, 143, 144, and 157).
'By itself, the Clean function does not remove these additional nonprinting characters.
Remove_All_Non_Printing_Characters_Except_For_White_Spaces = Application.WorksheetFunction.Clean(str)
End Function


Sub Test__Month_Abbreviation()
MsgBox Month_Abbreviation(1)
End Sub
Function Month_Abbreviation(monthNumber As Integer)

Select Case monthNumber
    Case 1
        Month_Abbreviation = "Jan"
    Case 2
        Month_Abbreviation = "Feb"
    Case 3
        Month_Abbreviation = "Mar"
    Case 4
        Month_Abbreviation = "Apr"
    Case 5
        Month_Abbreviation = "May"
    Case 6
        Month_Abbreviation = "Jun"
    Case 7
        Month_Abbreviation = "Jul"
    Case 8
        Month_Abbreviation = "Aug"
    Case 9
        Month_Abbreviation = "Sep"
    Case 10
        Month_Abbreviation = "Oct"
    Case 11
        Month_Abbreviation = "Nov"
    Case 12
        Month_Abbreviation = "Dec"
End Select

End Function

Sub Send_Mail_From_Excel2(subjectLine As String, emailBody As String)

Dim OutlookApp As Object
Dim OutlookMail As Object

Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

'Send Mass Email Using Excel VBA Macro Code
With OutlookMail
    .to = "youremail@some.com"
    .CC = ""
    .BCC = ""
    .Subject = subjectLine
    .HTMLBody = emailBody
    '.Send  ' or just put .Send to directly send the mail instead of display
    .Display
End With

Set OutlookMail = Nothing
Set OutlookApp = Nothing

End Sub

And finally, just above "Module 1", you will see ThisWorkbook. Double click on that and insert the following code into that module. (If a sub with this same name exists, override it.)

Private Sub Workbook_Open()
On Error GoTo Something_Went_Wrong
Call Test__Check_Date
Exit Sub
Something_Went_Wrong:
MsgBox "Something went wrong:", vbCritical, "Failed to check Date"

End Sub

And lastly, currently (as @Logit had it set also in his code), when you want to actually send an email, in the email sub (at the very end of the code), comment (or delete) .Display and uncomment (remove the ' from in front of) the .Send.

    '.Send  ' or just put .Send to directly send the mail instead of display
    .Display

 

[Creativeboy4]

Dear *cmowla,

Thank you for the video reply. Everything works now completely fine. Thank you guys for the support!

 

[Logit]

Glad you have an answer.