Sending mails to specific recipients based on a cells value

Yolandi

New Member
Joined
May 26, 2016
Messages
30
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?
 

Yolandi

New Member
Joined
May 26, 2016
Messages
30
hi, no mails are sent falsely, but it is creating blank mails for those that are not 999
 

Some videos you may like

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.

Yolandi

New Member
Joined
May 26, 2016
Messages
30
hi, is there a way to group the emails so that only one email gets sent per rep for all their lines?
 

ManiacB

Board Regular
Joined
Aug 11, 2020
Messages
50
Office Version
  1. 365
Platform
  1. Windows
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
 
Solution

Yolandi

New Member
Joined
May 26, 2016
Messages
30

ADVERTISEMENT

hi, it gives error code: subscript out of range
 

Yolandi

New Member
Joined
May 26, 2016
Messages
30
Hi,

sorry to be a pain,

1 - when I replace the old code with the new one, and click run it gives two options to run :
  • sheet1.email_filter_bulk2
  • sheet1.send_newemail4
which one do I run first?

2- it also error code: subscript out of range,

3 - also it only pulls the following data through:
Good day,

Please see SOH with no sales on the below line:




Peet


Kind Regards,

Yolandi van den Berg.
 

ManiacB

Board Regular
Joined
Aug 11, 2020
Messages
50
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

1) Run
  • sheet1.email_filter_bulk2
 

Yolandi

New Member
Joined
May 26, 2016
Messages
30
Hi,

still giving the below problems

1 - when I replace the old code with the new one, and click run it gives two options to run :
  • sheet1.email_filter_bulk2 - error code: subscript out of range,
  • sheet1.send_newemail4 - it only pulls the following data through instead of all the data that the previous code pulled through:
Good day,

Please see SOH with no sales on the below line:


Peet


Kind Regards,

Yolandi van den Berg.


The previous code was perfect, i just want to alter it to send the data in bulk for each rep
 

ManiacB

Board Regular
Joined
Aug 11, 2020
Messages
50
Office Version
  1. 365
Platform
  1. Windows
The code assumes the data is in a workbook in a worksheet named "Sheet1". If that is not true, rename the sheet name field in the code.

VBA Code:
sht = "Sheet1"

"sheet1.email_filter_bulk2" uses "sheet1.send_newemail4" in its process, so don't execute the ..newemail4.. subroutine directly.
 

Watch MrExcel Video

Forum statistics

Threads
1,113,895
Messages
5,544,901
Members
410,643
Latest member
sng
Top