VBA Code to Copy Data from Cells to Email if Another Cell Equals Current Date

[tkc5869]

Hi all,

I'm new to VBA but am trying to automate a spreadsheet to automatically send out an email when a cell value equals "Complete". The flow I have in mind is that when a dropdown value is selected "Complete", then the data from another cell will be copied into an email body and automatically sent to several addresses. So far, I only have subroutines set up to generate the email minus the data from the cells I need. Also, the range I have selected is for all cells in column J, but there may be a simpler way to define this.

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = True
If Not Intersect(Target, Range("J1:J30000")) Is Nothing Then
Select Case Target.Value
Case "Complete"
SendOrderStatusComplete

End Select
End If

If Not Intersect(Target, Range("J1:J30000")) Is Nothing Then
Target.Offset(0, 1) = Date
End If

End Sub

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here (de-sensitized if necessary). We need to know which cell you want to add to the body of the email and where the email address of the recipients are located. We also need to know the subject of the email and what other text you may want to add to the body. It would help if you could attach a screen shot of what the complete email would look like.

 

[tkc5869]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here (de-sensitized if necessary). We need to know which cell you want to add to the body of the email and where the email address of the recipients are located. We also need to know the subject of the email and what other text you may want to add to the body. It would help if you could attach a screen shot of what the complete email would look like.

I'll post the XL2BBCode below. As well as an example of an email message with Cell names representing the data needed input in the message.

Dummy Workbook.xlsm
	C	D	E	F	G	H	I	J	K
1	Planner to Update			Planner to Update
2	Build Week	SEQUENCE	WORK ORDER #	Planner Notes	Cust. Commit GI Dt	Cust. Req GI Dt	Ord. Cr. Date	Order Status	Completed
3	44641	6	104738169		11/22/21	11/22/21	8/16/2021		3/25/2021
4	44641	2	104646560		3/25/22	12/16/21	12/2/2021		3/25/2021
5	44641	3	104618704		1/7/22	1/7/22			3/25/2021
6	44641	1	104740752		1/20/22	1/13/22	10/10/2021		3/25/2021
7	44641	28	104747918	RELABEL JOB	1/20/22	1/20/22	10/8/2021		3/25/2021
8	44641	41	104749567		2/11/22	2/11/22	12/17/2021		3/25/2021
9	44641	8	104741297		3/30/22	3/16/22	11/18/2021		3/25/2021
10	44641	39	104749376	RELABEL JOB	3/17/22	3/17/22	2/23/2022		3/25/2021
11	44641	9	104741298		3/23/22	3/23/22	1/28/2022		3/26/2021
12	44641	45	104750921		4/8/22	3/24/22	3/15/2022		3/26/2021
13	44641	15	6039611	special slit request	3/25/22	3/25/22	3/18/2022		3/26/2021
14	44641	18	6039614	special slit request	3/25/22	3/25/22	3/18/2022		3/26/2021
15	44641	19	6039615	special slit request	3/25/22	3/25/22	3/18/2022		3/26/2021
16	44641	20	6039616	special slit request	3/25/22	3/25/22	3/18/2022		3/26/2021
17	44641	42	104751040		3/25/22	3/25/22	12/14/2021		3/26/2021
18	44641	24	104745995		3/28/22	3/28/22	3/21/2022		3/26/2021
19	44641	27	6039610	special slit request	3/28/22	3/28/22	3/17/2022		3/26/2021
20	44641	43	104750939		3/28/22	3/28/22	1/14/2022		3/26/2021
21	44641	7	104741296		3/29/22	3/29/22	12/6/2021
22	44641	40	104749565	EXPEDITE	3/29/22	3/29/22	2/3/2022
23	44641	10	104741299		3/30/22	3/30/22	3/9/2022
24	44641	44	104750922		3/30/22	3/30/22	2/14/2022
25	44641	26	104747776		4/5/22	4/1/22	2/3/2022
26	44641	29	104749204		4/4/22	4/4/22	2/16/2022
27	44641	30	104749206		4/7/22	4/4/22	2/20/2022
28	44641	25	104746085		4/7/22	4/7/22	3/18/2022
29	44641	31	104749208		4/7/22	4/7/22	2/21/2022
30	44641	4	104731951		4/11/22	4/11/22	12/23/2021
31	44641	11	104741320		4/14/22	4/14/22	2/25/2022
32	44641	32	104749209		4/15/22	4/15/22	2/28/2022
33	44641	12	104741321		4/21/22	4/18/22	3/6/2022
34	44641	33	104749210		4/21/22	4/18/22	3/6/2022
35	44641	34	104749211		4/21/22	4/18/22	3/6/2022
36	44641	35	104749212		4/21/22	4/18/22	3/6/2022
37	44641	36	104749214		4/21/22	4/18/22	3/6/2022
38	44641	46	104751142	ASAP	4/18/22	4/18/22	12/9/2021
39	44641	5	104736471		4/19/22	4/19/22	3/3/2022
40	44641	13	104741322		4/19/22	4/19/22	1/24/2022
41	44641	37	104749215		4/19/22	4/19/22	3/3/2022
42	44641	14	104741323		4/21/22	4/21/22	2/8/2022
43	44641	38	104749216		4/29/22	4/29/22	3/15/2022
Sheet1

Cells with Data Validation
Cell	Allow	Criteria
J3:J43	List	=Sheet2!$A$1:$A$3

 

[mumps]

I noticed that you don't have a drop down in column J. Do you want to create the email when a completed date is entered in column I?

 

[tkc5869]

I noticed that you don't have a drop down in column J. Do you want to create the email when a completed date is entered in column I?

I noticed that you don't have a drop down in column J. Do you want to create the email when a completed date is entered in column I?

I do have a drop down column in column J. When "Completed" is selected in the drop down, it will generate the email.

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Select "Complete" in column J.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 10 Then Exit Sub
    Dim OutApp As Object, OutMail As Object
    Application.ScreenUpdating = False
    If Target = "Complete" Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .To = ""
            .Subject = "Slitting Job# " & Range("E" & Target.Row).Value & " Completed"
            .HTMLBody = "This is a notification that Job# " & Range("E" & Target.Row).Value & " has been completed."
            .Display
        End With
    End If
    Application.ScreenUpdating = True
End Sub