VBA Code to send email only once based on cell value

[Malcolm torishi]

Hi
can anyone suggest if there is any way of sending an email only the once based on a cell value. Basically I have a VBA Code that sends an email automatically when my cell AA4 = 1. What I want the code to do now is
1 only send the email once and not go into a loop and continually send emails
2 also my cell AA4 value changes my way of adding 1 to the existing value, so when the cell gets to 2 I would like the email to be sent again the once and when the cell gets to 3 again I would like the email to be sent again and so on each time my AA4 cell keeps increasing my 1
is this at all possible, if so please let me know and thank you

 

[Yongle]

Basically I have a VBA Code that sends an email automatically when my cell AA4 = 1

1 Post the code and I will help you amend it

- paste the code into your reply
- then select the whole of the code
- click on icon # immediately above reply window
- code tags are placed around your code
- it makes the code easier to read


[CODE tag]
your code
[/CODE tag]

2 Explain exactly what is done to change the value in AA4
- I need to understand what triggers the change in value

 

[Malcolm torishi]

1 Post the code and I will help you amend it

- paste the code into your reply
- then select the whole of the code
- click on icon # immediately above reply window
- code tags are placed around your code
- it makes the code easier to read


[CODE tag]
your code
[/CODE tag]

2 Explain exactly what is done to change the value in AA4
- I need to understand what triggers the change in value

I will get back to you Monday with the code etc , thank you

 

[Malcolm torishi]

Hi Yongle
Currently the below VBA codes and Formulas within my spreadsheet can send an automated email out based on if the cell value in AF6 is >0. When the email has been sent the VBA code below, drops a 1 into cell AC5 which then over writes the Sum formula in AF6 with “Email Sent” which then stops any more emails being sent out.

So the problem I have currently is because the value 1 has been dropped into cell AC5 from the VBA code after my 1st email has been sent out, if another 1 value appears in range AF7:AF27 it does not get totalled up using the Sum formula in cell AF6 because AC5 already = 1 from the VBA code after the 1st email was sent out.

What I would like to do now is change the VBA Code below so that each time a 1 value appears in range AF7:AF27 it will send one email only to the email addresses that are in, AJ12-15, with the name of the person that appears in range AJ7:AJ27 in the “Body Message” part of the VBA code. So for example using my index range AH7:AH27, index 1 will have in cell AJ7 say TOM, index 2 will have inAJ8 say BILL. So each time a 1 value appears in range AF7:AF27 the code will send one mail only to the email addresses with each person name from range AJ7:AF27

Hopefully I have explained and if you can help this is a big help in me completing my spread sheet , thank you.

Formulas in Spreadsheet

AF6 contains =IF(AC5=1,"Email Sent",SUM(AF7:AF27)) . So my AF6 cell can either contain a value between 0 & 21, based on sum formula or “Email Sent”. This AF6 cell is my trigger cell that sends an automated email if the cell value is > 0
AC5 gets a 1 entered, from the VBA code below, into the cell to stop the automated email being continuously sent and going into a loop.
AF7:AF27 contains an IF formula that put either a 0 or 1 into the cell
AJ12-15 contain email address
AH7:AH27 contains a value from 1 in AH7 to 21 in AH27 , these numbers 1-27 are just used as an index
AJ7:AJ27 can be either blank or contain people’s names


VBA Codes

Private Sub Worksheet_Calculate()
    If IsNumeric(Range("AF6").Value) And Range("AF6").Value > 0 Then
        Call Mail_small_Text_Outlook
    End If
End Sub

Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = Range("AJ2").Value & ";" & Range("AJ3").Value & ";" & Range("AJ4").Value
        .CC = Range("AJ5").Value
        .BCC = ""
        .Subject = "Warning, Patient " & Range("AJ6").Value & " is Late Back"
        .Body = "Body Message"
        .send   'or use .Send
    End With
    Range("AC5").Value = 1
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
    If Range("AC5").Value = 1 Then
    MsgBox "Message Pop Up  ."
    End If
End Sub

 

[Malcolm torishi]

Not sure if this needs to be a new tread but I think I am getting closer in achieving this , so does anyone know how to trigger the Sub Mail ….. code below based on 6 different cell values in the Private Sub …. code. If you could help thank you


Private Sub Worksheet_Calculate()
If IsNumeric(Range("AF6").Value) And Range("AU7").Value = 1 Then
Call Mail_small_Text_Outlook
End If
If IsNumeric(Range("AF6").Value) And Range("AU8").Value = 2 Then
Call Mail_small_Text_Outlook
End If
If IsNumeric(Range("AF6").Value) And Range("AU9").Value = 3 Then
Call Mail_small_Text_Outlook
End If
If IsNumeric(Range("AF6").Value) And Range("AU10").Value = 4 Then
Call Mail_small_Text_Outlook
End If
If IsNumeric(Range("AF6").Value) And Range("AU11").Value = 5 Then
Call Mail_small_Text_Outlook
End If
If IsNumeric(Range("AF6").Value) And Range("AU12").Value = 6 Then
Call Mail_small_Text_Outlook
End If
End Sub




Sub Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next
With xOutMail
.To = Range("AJ2").Value & ";" & Range("AJ3").Value & ";" & Range("AJ4").Value
.CC = Range("AJ5").Value
.BCC = ""
.Subject = "Warning, Patient " & Range("AJ6").Value & " is Late Back"
.Body = "This is a warning, to warn you that " & Range("AJ6").Value & " is late back on the ward and should of arrived back at " & Range("AL6").Text & " Please see Late Returnee Pass Out Photo on Patient Tracker for current ID photo fit"
.send 'or use .Send
End With
Range("AV7").Value = X
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
If Range("AV7").Value = X Then
MsgBox "An automated email has just been sent to your Manager warning them of a patient being late on returning back to the ward, please check the Patient Tracker for further details ."
End If