Email automatically based on information in column A

[SomeCallMeGenius]

Hi All,

I get a daily email from the MIS with details on the performance on my team members. For agents who are below a particular threshold needs to be sent email on daily basis. I have a big team, so some times this get tedious. I believe this can be automated using VB but I am not very good in it, so requesting for help from you guys.

Here is what the sheets looks like -

Sheet one

Excel Workbook
	C	D	E
3	Name	Productivity	Performance
4	Samantha	85	Excellent
5	Roger	75	Above Average
6	Christie	65	Average
7	Alex	55	Below Average
8	Jonathan	45	Poor
9	David	87	Excellent
10	Chritian	67	Average
11	Amanda	78	Above Average
12	Victor	89	Excellent
Sheet1

Excel 2007

What I want is that the macro/vb program to automatically pickup agent name whose performance index is "Average" , "Below Average" or "Poor" and also pickup their productivity figure, check their name in sheet 2 for their email address and send them an email like this -

"Hello Agent name,

Your productivity for yesterday was (mention productivity figure here), can you please let us know the reason for the same.

Thanks,
-SG"

here is what the sheet two looks like

Excel Workbook
	F	G
4	Alex	alex@domainname.com
5	Amanda	Amanda@domainname.com
6	Christie	Christie@domainname.com
7	Chritian	Chritian@domainname.com
8	David	David@domainname.com
9	Jonathan	Jonathan@domainname.com
10	Roger	Roger@domainname.com
11	Samantha	Samantha@domainname.com
12	Victor	Victor@domainname.com
Sheet1

Excel 2007

Please help me guys.

Thanks,
-SG

 

[SomeCallMeGenius]

My code so far, but not working


Option Explicit

Sub email_agents()
Dim row As Integer
Dim row2 As Integer
Dim agent_name As String
Dim emailadd As String
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


Worksheets("sheet1").Activate

For row = 1 To 7
Worksheets("sheet1").Activate
If Cells(row, 4).Value = "Poor" Then
GoTo email
ElseIf Cells(row, 4).Value = "Average" Then
GoTo email
ElseIf Cells(row, 4).Value = "below Average" Then
GoTo email
Else: GoTo option2

email:
agent_name = Cells(row, 3).Value
Worksheets("emailaddress").Activate
For row2 = 1 To 7
If agent_name = Worksheets("emailaddress").Cells(row2, 3).Value Then
GoTo rogerthat
End If

rogerthat:
emailadd = Worksheets("emailaddress").Cells(row2, 4).Value
strbody = "Hi" & " " & agent_name & "," & vbNewLine & vbNewLine & _
"Your productivity for yesterday was" & " " & "Productivity number" & vbNewLine & _
"Please review this and get back to us with your findings" & vbNewLine & _
"thanks and regards"

With OutMail
.To = emailadd
.cc = "manager@company.com" & ";" & "teamlead@compnay.com"
.bcc = ""
.Subject = "Please review this"
.body = strbody
.display

Next row2

option2:
End If

Next row

End Sub

 

[Warship]

Try this:

Option Explicit
Dim emailAddress As String
Dim emailSubject As String
Dim emailName As String
Dim emailBody As String
Dim emailProductivity As String
Dim emailPerformance As String
Dim emailTable As Range
Dim prodTable As Range
Dim found As Range
Dim notFound As String
Dim notFormat As String
Dim x As Long

Sub processEmails()
    Set prodTable = Sheets("Sheet1").Range("A1").CurrentRegion
    Set emailTable = Sheets("Sheet2").Range("A1").CurrentRegion
    notFound = ""
    notFormat = ""
    
    For x = 2 To prodTable.Rows.Count
        If prodTable.Cells(x, 3) = "Average" _
         Or prodTable.Cells(x, 3) = "Below Average" _
         Or prodTable.Cells(x, 3) = "Poor" Then
            
            Set found = emailTable.Find(prodTable.Cells(x, 1), , xlValues, xlWhole)
            If Not found Is Nothing Then
                If found.Offset(, 1).Value Like ("*@*.*") Then
                    emailName = prodTable.Cells(x, 1)
                    emailProductivity = prodTable.Cells(x, 2)
                    emailPerformance = prodTable.Cells(x, 3)
                    emailAddress = found.Offset(, 1)
                    emailSubject = emailPerformance & " Performance Rating"
                    emailBody = "Hello " & emailName & "," & vbLf & _
                                "Your productivity for yesterday was " & emailProductivity & "," & vbLf & _
                                "can you please let us know the reason for the same." & vbLf & _
                                "Thanks," & vbLf & "-SG"
                    sendEmail
                Else
                    notFormat = notFormat & found.Offset(, 1).Value & " (" & found & ")" & vbLf
                End If
            Else
                notFound = notFound & prodTable.Cells(x, 1) & vbLf
            End If
        End If
    Next x
    
    If Len(notFound) > 0 Or Len(notFormat) > 0 Then
        MsgBox "Name not found or bad email address format: " & vbLf & notFound & notFormat, , "Errors"
    End If
End Sub

Private Sub sendEmail()
    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = emailAddress
        .CC = ""
        .BCC = ""
        .Subject = emailSubject
        .Body = emailBody
        .Display 'or .Send
    End With
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[Warship]

Keep in mind all names will have to be unique.
If you have two Sams on the list, the first Sam on the email table will get both emails.

 

[SomeCallMeGenius]

Thanks man, I will try this

 

[SomeCallMeGenius]

Yup, works perfectly. You are the best