Results 1 to 7 of 7

Thread: Email multiple users based on result of applied filter

  1. #1
    Neophyte Ana Sheila Martins's Avatar
    Join Date
    Nov 2011
    Location
    Carregado, Lisboa, Portugal, Portugal
    Posts
    4
    Articles
    0

    Email multiple users based on result of applied filter



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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.

    Example:

    To: John Smith(12345@smsprovider.com); Samuel Jackson(54321@smsprovider.com)
    Subject: SMS (this subject is always fixed as, yes, it's actually sending a text message via email to the manager's cell phone)
    Message:
    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.
    Attached Files Attached Files

  2. #2
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,087
    Articles
    79
    Blog Entries
    14
    Hi there, and welcome to the forum.

    The following code should go in a standard module in your workbook (let me know if you need help placing that):
    Code:
    Sub SendAlerts()
        Dim nm As Name
        Dim sArea As String
        Dim sRecipients As String
        Dim sMsg As String
        Dim cl As Range
        Dim rngTable As Range
        'Capture key details
        With Worksheets("Sheet 1")
            sArea = .Range("B4")
            sMsg = .Range("C4")
        End With
        'Determine range to search for emails
        With Worksheets("Sheet 2")
            Set rngTable = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
        End With
        'Get list of recipients
        For Each cl In rngTable
            If cl.Value = sArea Then
                sRecipients = sRecipients & cl.Offset(0, 1).Value & " (" & cl.Offset(0, 2).Value & ");"
            End If
        Next cl
        'Check if any recipients found
        If Len(sRecipients) > 0 Then
            sRecipients = Left(sRecipients, Len(sRecipients) - 1)
            'Send the email
            Call SendEmail(sRecipients, "SMS", sMsg)
        Else
            MsgBox "Sorry, no recipients found!"
        End If
    End Sub
    Sub SendEmail(sRecipients As String, sSubject As String, sBody As String)
    'Macro Purpose: To send an email through Outlook
        Dim objOL As Object
        Dim objMail As Object
        'Turn on error handling
        On Error GoTo Cleanup
        'Bind to Outlook
        Set objOL = CreateObject("Outlook.Application")
        'Create a new email and send it
        Set objMail = objOL.CreateItem(0)    '0=olmailitem
        With objMail
            .To = sRecipients
            .Subject = sSubject
            .Body = sBody
            .Display
        End With
    Cleanup:
        'Release all objects
        Set objMail = Nothing
        Set objOL = Nothing
        On Error GoTo 0
    End Sub
    You should then be able to link your button to the "SendAlerts" macro.

    Once you're happy that it is working, change the line in the second routine from .Display to .Send and it will send automatically without previewing first.
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  3. #3
    Neophyte Ana Sheila Martins's Avatar
    Join Date
    Nov 2011
    Location
    Carregado, Lisboa, Portugal, Portugal
    Posts
    4
    Articles
    0
    Many, many, MANY thanks. It works like a dream! Thank you so much.

    Much appreciated

  4. #4
    Neophyte Ana Sheila Martins's Avatar
    Join Date
    Nov 2011
    Location
    Carregado, Lisboa, Portugal, Portugal
    Posts
    4
    Articles
    0
    Good morning again.

    I've been testing this and it really does work perfectly. There's just one little thing. I would like it to include the contents of both cells B4 and C4 in the body of the email. Yet if I change this in the code, it errors. I'm clearly doing it wrong. Can you help?

    Code:
    sMsg = .Range("C4")
    if I cange it
    Code:
    sMsg = .Range("B4:C4")
    it shows "Run-time error '13': Type mismatch".


    Thanks again

  5. #5
    Neophyte Ana Sheila Martins's Avatar
    Join Date
    Nov 2011
    Location
    Carregado, Lisboa, Portugal, Portugal
    Posts
    4
    Articles
    0
    Actually, I had a cup of coffee, sat down and THOUGHT....and I figured it out. There's probably a much easier way to do it but hey, I got it to work hehehe. I changed the following:

    Code:
    sMsg = .Range("B4") & .Range("C4")
    and it now works beautifully. It now shows in the body of the email exactly what area is being reported, as well as a brief message.

    Thank you again and best regards!

  6. #6
    Administrator Ken Puls's Avatar
    Join Date
    Mar 2011
    Location
    Nanaimo, BC, Canada
    Posts
    2,087
    Articles
    79
    Blog Entries
    14
    There's probably a much easier way to do it
    Actually, that's exatly what I would have done. Glad you got it working!
    Ken Puls, FCPA, FCMA, MS MVP (Excel)

    Master your data with Power Query: Purchase your copy of my book M is for Data Monkey today!

    Main Site: http://www.excelguru.ca -||- Blog: http://www.excelguru.ca/blog -||- Forums: http://www.excelguru.ca/forums
    Check out the Excelguru Facebook Fan Page -||- Follow Me on Twitter

    If you've been given VBA code (a macro) for your solution, but don't know where to put it, CLICK HERE.

  7. #7

    Sending email from xls brings up a microsoft office outlook deny and allow message

    Hi

    Thanks for the code below, works perfect, one thing I want to know. How do i get rid of the following message box once I get to send:
    Microsoft Office Outlook ... Allow Deny Help.

    Thanks
    Marlene

    Quote Originally Posted by Ken Puls View Post
    Hi there, and welcome to the forum.

    The following code should go in a standard module in your workbook (let me know if you need help placing that):
    Code:
    Sub SendAlerts()
        Dim nm As Name
        Dim sArea As String
        Dim sRecipients As String
        Dim sMsg As String
        Dim cl As Range
        Dim rngTable As Range
        'Capture key details
        With Worksheets("Sheet 1")
            sArea = .Range("B4")
            sMsg = .Range("C4")
        End With
        'Determine range to search for emails
        With Worksheets("Sheet 2")
            Set rngTable = .Range("A2:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
        End With
        'Get list of recipients
        For Each cl In rngTable
            If cl.Value = sArea Then
                sRecipients = sRecipients & cl.Offset(0, 1).Value & " (" & cl.Offset(0, 2).Value & ");"
            End If
        Next cl
        'Check if any recipients found
        If Len(sRecipients) > 0 Then
            sRecipients = Left(sRecipients, Len(sRecipients) - 1)
            'Send the email
            Call SendEmail(sRecipients, "SMS", sMsg)
        Else
            MsgBox "Sorry, no recipients found!"
        End If
    End Sub
    Sub SendEmail(sRecipients As String, sSubject As String, sBody As String)
    'Macro Purpose: To send an email through Outlook
        Dim objOL As Object
        Dim objMail As Object
        'Turn on error handling
        On Error GoTo Cleanup
        'Bind to Outlook
        Set objOL = CreateObject("Outlook.Application")
        'Create a new email and send it
        Set objMail = objOL.CreateItem(0)    '0=olmailitem
        With objMail
            .To = sRecipients
            .Subject = sSubject
            .Body = sBody
            .Display
        End With
    Cleanup:
        'Release all objects
        Set objMail = Nothing
        Set objOL = Nothing
        On Error GoTo 0
    End Sub
    You should then be able to link your button to the "SendAlerts" macro.

    Once you're happy that it is working, change the line in the second routine from .Display to .Send and it will send automatically without previewing first.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •