Sending mails to specific recipients based on a cells value

Yolandi

New Member
Joined
May 26, 2016
Messages
34
Good morning,

I am trying to get excel to send out an email to different sales reps.
So if row X is an error code of "999" then excel needs to send an email to the rep (I placed the email addresses in row K as it differs for every line), but if row X is "0" excel should not send an email.
is this possible? and what formula should i use?
 
Here is a solution that will aggregate common Sales Rep to one email.

VBA Code:
Sub Email_filter_Bulk2()
'This code writes to Range BB and then deletes that data
'It creates new worksheets that are then deleted As well

Application.ScreenUpdating = False
Dim x As Range
Dim Rng As Range
Dim last  As Long
Dim sht As String

'specify sheet name in which the data is stored
sht = "Sheet1"

last = Sheets(sht).Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = Sheets(sht).Range("A1:Z" & last)
Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True

    For Each x In Range([BB2], Cells(Rows.Count, "BB").End(xlUp))
            With Rng
                .AutoFilter
                .AutoFilter field:=1, Criteria1:=x.Value
                        .SpecialCells(xlCellTypeVisible).Copy
                        Sheets.Add(after:=Sheets(Sheets.Count)).Name = x.Value
                        ActiveSheet.Paste

                        Columns("Y:Z").EntireColumn.Hidden = True
                            'Call code below
                            Send_newemail4
                        Columns("Y:Z").EntireColumn.Hidden = False
                '       Code Removes new sheet that was created
                        Application.DisplayAlerts = False
                            Sheets(x.Text).Delete
                        Application.DisplayAlerts = True
            End With
    Next x

    ' Turn off filter
    With Sheets(sht)
        Rng.AutoFilter
    End With
    ' Remove data from column BB
    Range([BB2], Cells(Rows.Count, "BB").End(xlUp)) = ""
    With Application
    .CutCopyMode = False
    .ScreenUpdating = True
    End With

End Sub

Sub Send_newemail4()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Rng As Range
    Dim lr, a, b, y As Integer
    Dim Signature As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
  
    Set Rng = Nothing
    Set Rng = Selection.SpecialCells(xlCellTypeVisible)
    With OutMail
        .Display
    End With
    Signature = OutMail.HTMLBody
   
    With OutMail
        .To = Range("Z2").Value
        .CC = "" 'Range("AA2").Value
        .Subject = "SOH with no Sales"
        .HTMLBody = "Good day, " & Chr(11) & Chr(11) & "Please see SOH with no sales on the below line:" & Chr(11) & Chr(11) & RangetoHTML(Rng) & Chr(11) & Chr(11) & "Kind Regards," & Chr(11) & Chr(11) & "Yolandi van den Berg." & Chr(11) & Chr(11) & Signature
        '.Attachments.Add Range("E2").Value  '("") For attachments
        .Display ' Place apostrophe in front of .display to stop drafts being made
        '.Send ' Remove apostrophe to automatically send the email
   End With
   Set OutMail = Nothing
   Set OutApp = Nothing
   
End Sub

Function RangetoHTML(Rng As Range)
'
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    Rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         FileName:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function
hi, is there a way to send the bulk email without creating a new tab for each sales rep? also the mail pulls through blank
 
Upvote 0

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Are you saying the solution doesn't work now? The creation of tabs happens to aggregate common emails. I am using the first name as a differentiation as that was the only field that had different values in the data you provided. If the email is blank it may be because there is a blank first name.

Change this line

VBA Code:
Sheets(sht).Range("A1:A" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True

to this

VBA Code:
Sheets(sht).Range("Z1:Z" & last).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("BB1"), Unique:=True

to start using the email address as the differentiator.
 
Upvote 0
Good day,

just a question, is there a way to alter the Marco to send one email per rep?
so it will mass send all lines that are the same rep and send it to that rep in one mail
 
Upvote 0
Hi,

please ignore previous message, so I am using your codes, but its not pulling the email address through?

I have made another tab with the email address as well, is there a way to pull it from there?
 
Upvote 0
The code is written to pull the email from column Z. Moving the email to another sheet will require a rewrite of the code.
 
Upvote 0

Forum statistics

Threads
1,213,490
Messages
6,113,957
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top