Email multiple users based on result of applied filter

This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.


Thread Starter
Nov 3, 2011
Good morning,

I need a little help with a project I am working on. What I have is an incident alert system. I have attached an example workbook (Excel 2003) for easier understanding.

On sheet 1, column B4, I have a Data Validation List, whereby a user can select which area is being problematic. Column C is a free-text cell where they can type in a short message explaining what the problem is. Column D is a button that they click that will fire off an email to a group of managers.

Sheet 2 is a list of all the areas and the manager responsible for that area.

What I need is a one-button macro that will:

1) In Sheet 2 column A, automatically apply a filter, based on whatever is currently the value of Sheet 1, B4.(whatever the user selects from the dropdown list). This will possibly be a filter based on ActiveCell value, I think?

2) Send off an email to each manager of the area that has been filtered in step 1.

2.1) The contents of Sheet 1, B4 and C4 should be the body of the email.


To: John Smith([email protected]); Samuel Jackson([email protected])
Subject: SMS (this subject is always fixed as, yes, it's actually sending a text message via email to the manager's cell phone)
Incident: (value of Sheet 1, B4)Lobby - (value of Sheet 1, C4)Strange man loitering in the lobby.

Is this possible?

I hope I've explained clearly enough what I need. I'm not great at that. :s

Thank you very kindly in advance for your assistance. I greatly appreciate your efforts.


Jul 25, 2004
Where do the addresses come into play? I didn't see them listed on your sheet. Assuming you will put this data in the adjacent rows in column C on Sheet 2, you could use something like this ...

Option Explicit

Sub CreateOutlookEmail()

    '/// Declare variables
    Dim olApp                   As Object
    Dim olEmail                 As Object
    Dim wsList                  As Worksheet
    Dim wsData                  As Worksheet
    Dim rLook                   As Range
    Dim rLoop                   As Range
    Dim blnAppOpen              As Boolean
    Dim sListRecip              As String

    Const sDelim                As String = "; "

    '/// Speed up application settings for running code
'    Call TOGGLEEVENTS(False)
    '/// Check fields
    blnAppOpen = True
    Set wsData = ThisWorkbook.Worksheets("Sheet 1")
    Set wsList = ThisWorkbook.Worksheets("Sheet 2")
    If Len(wsData.Range("B4").Value) = 0 Then
        MsgBox "You must choose an Area.", vbCritical, "ERROR!"
        GoTo ExitRoutine
    End If
    If Len(wsData.Range("C4").Value) = 0 Then
        MsgBox "You must enter a Problem Description.", vbCritical, "ERROR!"
        GoTo ExitRoutine
    End If
    '/// Get list of recipients
    Set rLoop = wsList.Range("A2", wsList.Cells(wsList.Rows.Count, "A").End(xlUp))
    For Each rLook In rLoop.Cells
        If rLook.Value = wsData.Range("B4").Value Then
            sListRecip = sListRecip & rLook.Offset(0, 2).Value & sDelim
        End If
    Next rLook
    '/// Check for application existence, create
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = CreateObject("Outlook.Application")
        blnAppOpen = False
    End If

    '/// Create email item
    Set olEmail = olApp.CreateItem(0)
    olEmail.To = sListRecip
    olEmail.Subject = "SMS"
    olEmail.Body = "Area: " & wsData.Range("B4").Value & vbCrLf & "Problem Description: " & wsData.Range("C4").Value
    olEmail.Display    'or use .Send


    '/// Reset application environment settings

    '/// Quit
    If blnAppOpen = False Then olApp.Quit

End Sub

Public Sub TOGGLEEVENTS(blnState As Boolean)
    'Originally written by Zack Barresse
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub
Not sure what ComputerMan will come up with, but there are certainly many ways to skin this cat.

One issue many people look to overcome is instead of just displaying the email, to just send it right away. You can do this, but you do not get the benefit of checking the message for accuracy/completeness prior to sending. If you want to do something like this, just let us know, as there are a few ways to get it done and we'll just have some questions for you to make sure we recommend the best method for your situation.

Take care.
Dec 4, 2007
I like Zack's suggestion about being able to check the message for accuracy/completeness. However, we are willing to help you accomplish whatever you had in mind.

Let us know if the code Zack provided will meet your needs or if modifications need to be done.
This thread has been Locked and is not open to further replies. Please start a New Thread if you're having a similar issue. View our Welcome Guide to learn how to use this site.

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

As Seen On
As Seen On...

Welcome to Tech Support Guy!

Are you looking for the solution to your computer problem? Join our site today to ask your question. This site is completely free -- paid for by advertisers and donations.

If you're not already familiar with forums, watch our Welcome Guide to get started.

Join over 807,865 other people just like you!

Latest posts