Emailing report for each item in filter/slicer

[psl1089]

Hi all,

Hopefully I can explain this well enough - I have a dashboard based off of tables on other sheets which can be filtered to show results for individual departments. I also have corresponding email addresses for each department that the filtered results need to be send to.

Is there any way I can loop through each filter item and automatically send to the proper recipients? I can partially brute force my way through it with the macro recorder to at least make a copy of the workbook for each department, but that would still mean manually emailing out 50+ files.

 

[Worf]

Hi and welcome to the Board

• Do you have a slicer with the department names? Is the procedure to click the item and then email the filtered results?
• Do you have a worksheet table with departments and corresponding emails?
• What do you need to send: a range, a worksheet or the entire workbook?

 

[psl1089]

Yes to all the questions, and I would like to send the entire workbook if possible!

 

[Worf]

This example creates one email message for each slicer item:

Sub MailReports()
Dim i%, j%, sc As SlicerCache, olapp As Object, olmail As Object, sdata As Worksheet, res
Set olapp = CreateObject("Outlook.Application")
Set sdata = Sheets("table")                                 ' where mail addresses are
Set sc = ActiveWorkbook.SlicerCaches("Dept_Slicer")         ' your slicer name here
For i = 1 To sc.SlicerItems.Count
    sc.ClearManualFilter
    sc.SlicerItems(i).Selected = True
    For j = 1 To sc.SlicerItems.Count
        If j <> i Then sc.SlicerItems(j).Selected = False
    Next
    ActiveWorkbook.Save
    Set olmail = olapp.CreateItem(0)
    res = Application.VLookup(sc.SlicerItems(i).Name, sdata.[H1:I99], 2, False)
    If IsError(res) Then
        MsgBox "Could not find email address"
        Exit Sub
    End If
    With olmail
        .To = res                                           ' address previously found
        .Subject = "Report"
        .body = "Department " & sc.SlicerItems(i).Name
        .Attachments.Add Application.ActiveWorkbook.FullName
        .display                                            ' use Send here
    End With
Next
Set olmail = Nothing
Set olapp = Nothing
End Sub

 

[psl1089]

You are amazing, thank you so much!!

 

[Worf]

You are welcome!