VBA Email When a percentage hits 100.

[PaulOPTC]

Good afternoon,

Hoping to get some help on this one.

I have a file that has a list of jobs, my boss will then put a % to each one of these jobs in E starting from E6.

Once that percentage hits 100%, I would like it to send an email to our billing person, that says something along the lines of:

"Hey, Job number B6, D6 is complete, please bill out. "

Then once its billed Mark P6 with "sent" so that it doesnt send multi emails for the same job.


Heres what I have so far, it does not work.

Option Explicit

Sub CompleteProjectEmail()

Dim i As Long
   Dim OutApp As Object
    Dim OutMail As Object
   Dim strbody As String
 Dim Rng As Object
 
 
 
   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.CreateItem(0)
 

On Error GoTo Emailerror





    Set Rng = Range("E" & Cells(ActiveSheet.Rows.Count, "E6").End(xlUp).Row)
    For i = Rng.Cells.Count To 1 Step -1
        If Rng(i).Value = "100%" Then

    




   strbody = "Hey Everyone" & "<br>" & "<br>" & _
              "Job Number" & ActiveSheet.Range("B" & target.Row)& ActiveSheet.Range("D" & target.Row)& "was just marked 100%, Please start the billing process for this project." & "<br><br>" 

 
On Error Resume Next
 
    With OutMail
        .To = "Email"
     '  .cc = ""
     '  .Bcc = ""
       .Subject = "Complete Job - " & Range("B" & target.Row)
        .htmlBody = strbody
     'You can add a file like this
     ' .Attachments.Add (Range("J" & target.Row))
       '.Attachments.Add (Range("K" & target.Row))
       .send 'or use .send
    End With
    On Error GoTo 0
 
  Set OutMail = Nothing
   Set OutApp = Nothing
Else
End If


Exit Sub

Emailerror:

Exit Sub


Next i

End Sub

Any help would be appreciated!

 

[portews]

Well, for starters, in your code, Rng is dimensioned as an Object, rather than a Range. Target is not defined and doesn't mean anything in this code. You have your Next after you've exited the sub. Also, remember to put a space before the close quotes to put a space before the variable coming next in a string, otherwise you get "Job Number9Descriptionwas just marked..."

I don't have Outlook at home (only work) so I wasn't able to fully test this, but it seemed to work for what I was able to test. Rather than making the range variable I just found the last row and used that to loop through all the rows back to row 6.
Since you're using a percent sign in the E column, you need to look at the .Text, not .Value. The value of 100% is one, so that test would have failed.
I'm not sure if the .To works, I've always used the .Recipient.Add.
I also added a little error message box rather than quit mysteriously.

Try this:

Sub CompleteProjectEmail()

Dim i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim LastRow As Integer
Dim x As Variant

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error GoTo emailerror

LastRow = ActiveSheet.Range("E" & ActiveSheet.Rows.count).End(xlUp).Row

For i = LastRow To 6 Step -1
    If ActiveSheet.Range("E" & i).Text = "100%" And Not ActiveSheet.Range("P" & i).Text = "sent" Then
        With OutMail
            'Specify the email subject
            .Subject = "Complete Job - " & ActiveSheet.Range("B" & i)
             'Specify who it should be sent to
             'Repeat this line to add further recipients
            .Recipients.Add "billing@mycompany.com"
            .Recipients.Add "somebodyelse@mycompany.com"
            .HTMLbody = "Hey Everyone" & "<br>" & "<br>" & _
              "Job Number " & ActiveSheet.Range("B" & i) & " - " & ActiveSheet.Range("D" & i) & _
              " was just marked 100%, Please start the billing process for this project." & "<br><br>"
            'Choose which of the following 2 lines to have commented out
            '.Display 'This will display the message for you to check and send yourself
            .Send ' This will send the message straight away
        End With
    Range("P" & i) = "sent"
    End If
Next

Exit Sub

emailerror:
x = MsgBox("Error " & Err & vbLf & Err.Description, vbCritical, "Mail Error")
End Sub

 

[PaulOPTC]

Well, for starters, in your code, Rng is dimensioned as an Object, rather than a Range. Target is not defined and doesn't mean anything in this code. You have your Next after you've exited the sub. Also, remember to put a space before the close quotes to put a space before the variable coming next in a string, otherwise you get "Job Number9Descriptionwas just marked..."

I don't have Outlook at home (only work) so I wasn't able to fully test this, but it seemed to work for what I was able to test. Rather than making the range variable I just found the last row and used that to loop through all the rows back to row 6.
Since you're using a percent sign in the E column, you need to look at the .Text, not .Value. The value of 100% is one, so that test would have failed.
I'm not sure if the .To works, I've always used the .Recipient.Add.
I also added a little error message box rather than quit mysteriously.

Try this:

Sub CompleteProjectEmail()

Dim i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim LastRow As Integer
Dim x As Variant

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error GoTo emailerror

LastRow = ActiveSheet.Range("E" & ActiveSheet.Rows.count).End(xlUp).Row

For i = LastRow To 6 Step -1
    If ActiveSheet.Range("E" & i).Text = "100%" And Not ActiveSheet.Range("P" & i).Text = "sent" Then
        With OutMail
            'Specify the email subject
            .Subject = "Complete Job - " & ActiveSheet.Range("B" & i)
             'Specify who it should be sent to
             'Repeat this line to add further recipients
            .Recipients.Add "billing@mycompany.com"
            .Recipients.Add "somebodyelse@mycompany.com"
            .HTMLbody = "Hey Everyone" & "<br>" & "<br>" & _
              "Job Number " & ActiveSheet.Range("B" & i) & " - " & ActiveSheet.Range("D" & i) & _
              " was just marked 100%, Please start the billing process for this project." & "<br><br>"
            'Choose which of the following 2 lines to have commented out
            '.Display 'This will display the message for you to check and send yourself
            .Send ' This will send the message straight away
        End With
    Range("P" & i) = "sent"
    End If
Next

Exit Sub

emailerror:
x = MsgBox("Error " & Err & vbLf & Err.Description, vbCritical, "Mail Error")
End Sub

It works! But I keep getting an error message " Mail error, item has been moved or deleted" But it does send the email and mark it as sent, it is just doing one at a time, which is fine!
Thank you so much for your help!!

 

[PaulOPTC]

It works! But I keep getting an error message " Mail error, item has been moved or deleted" But it does send the email and mark it as sent, it is just doing one at a time, which is fine!
Thank you so much for your help

Well, for starters, in your code, Rng is dimensioned as an Object, rather than a Range. Target is not defined and doesn't mean anything in this code. You have your Next after you've exited the sub. Also, remember to put a space before the close quotes to put a space before the variable coming next in a string, otherwise you get "Job Number9Descriptionwas just marked..."

I don't have Outlook at home (only work) so I wasn't able to fully test this, but it seemed to work for what I was able to test. Rather than making the range variable I just found the last row and used that to loop through all the rows back to row 6.
Since you're using a percent sign in the E column, you need to look at the .Text, not .Value. The value of 100% is one, so that test would have failed.
I'm not sure if the .To works, I've always used the .Recipient.Add.
I also added a little error message box rather than quit mysteriously.

Try this:

Sub CompleteProjectEmail()

Dim i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim LastRow As Integer
Dim x As Variant

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error GoTo emailerror

LastRow = ActiveSheet.Range("E" & ActiveSheet.Rows.count).End(xlUp).Row

For i = LastRow To 6 Step -1
    If ActiveSheet.Range("E" & i).Text = "100%" And Not ActiveSheet.Range("P" & i).Text = "sent" Then
        With OutMail
            'Specify the email subject
            .Subject = "Complete Job - " & ActiveSheet.Range("B" & i)
             'Specify who it should be sent to
             'Repeat this line to add further recipients
            .Recipients.Add "billing@mycompany.com"
            .Recipients.Add "somebodyelse@mycompany.com"
            .HTMLbody = "Hey Everyone" & "<br>" & "<br>" & _
              "Job Number " & ActiveSheet.Range("B" & i) & " - " & ActiveSheet.Range("D" & i) & _
              " was just marked 100%, Please start the billing process for this project." & "<br><br>"
            'Choose which of the following 2 lines to have commented out
            '.Display 'This will display the message for you to check and send yourself
            .Send ' This will send the message straight away
        End With
    Range("P" & i) = "sent"
    End If
Next

Exit Sub

emailerror:
x = MsgBox("Error " & Err & vbLf & Err.Description, vbCritical, "Mail Error")
End Sub

One slight hickup actually, is there a way so we dont have to run the macro for it to work? it will just work when it sees that its at 100%? Like I just added a job, marked it at 100% and it didnt do anything, but if I run the macro it will send the email.

 

[portews]

Instead of the other code, put this in the worksheet code page. This should make it send the email when anything in the E column has changed to "100%" and there's no "sent" in P on that row.
I put in a Sleep to let it send the message and a .Quit to exit out of Outlook. Again, I don't have Outlook here to test it. See if that works.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim LastRow As Integer
Dim x As Variant

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
 
On Error GoTo emailerror
LastRow = ActiveSheet.Range("E" & ActiveSheet.Rows.count).End(xlUp).Row

    If Not Intersect(Range("E6:E" & LastRow), Target) Is Nothing And Target.Text = "100%" And Not ActiveSheet.Range("P" & Target.Row).Text = "sent" Then
        With OutMail
            'Specify the email subject
            .Subject = "Complete Job - " & Range("B" & Target.Row)
             'Specify who it should be sent to
             'Repeat this line to add further recipients
            .Recipients.Add "billing@mycompany.com"
            .Recipients.Add "somebodyelse@mycompany.com"
            .HTMLbody = "Hey Everyone" & "<br>" & "<br>" & _
              "Job Number " & ActiveSheet.Range("B" & Target.Row) & " - " & ActiveSheet.Range("D" & Target.Row) & _
              " was just marked 100%, Please start the billing process for this project." & "<br><br>"
            'Choose which of the following 2 lines to have commented out
            '.Display 'This will display the message for you to check and send yourself
            .Send ' This will send the message straight away
            Sleep (10000)
            .Quit
        End With
    Range("P" & Target.Row) = "sent"
    End If


Exit Sub

emailerror:
x = MsgBox("Error " & Err & vbLf & Err.Description, vbCritical, "Mail Error")
End Sub