Excel VBA to email multiple ranges as a PDF

[shophoney]

Trying to email as a PDF selected ranges with VBA.

Hi I tested using ChatGPT to ask the same question and i got the results below. But the data emailed is not using the slicers that are selected. It emails without slicer sections. I want filtered results.

Can anyone help.

Sub EmailMultipleRangesAsSinglePDF()

Dim OutApp As Object
Dim OutMail As Object
Dim TempFilePath As String
Dim TempFileName As String
Dim wb As Workbook
Dim ws As Worksheet
Dim combinedRange As Range
Dim rng1 As Range, rng2 As Range
Dim i As Integer

' Define your ranges here
Set ws = ThisWorkbook.Sheets("HIP Candice") ' Modify the sheet name as needed
Set rng1 = ws.Range("A2:I100") ' Modify the first range as needed
Set rng2 = ws.Range("L2:Q100") ' Modify the second range as needed

' Combine multiple ranges into a single range
Set combinedRange = Union(rng1, rng2)

' Create a new workbook and paste combined range into a new sheet
Set wb = Workbooks.Add
Set ws = wb.Sheets(1)
combinedRange.Copy ws.Range("A2")

' Create a temporary file path and name
TempFilePath = Environ$("temp") & "\"
TempFileName = "MultipleRangesAsSinglePDF_" & Format(Now, "yyyy-mm-dd\_hhmm") & ".pdf"

' Save the new workbook as PDF
wb.ExportAsFixedFormat Type:=xlTypePDF, Filename:=TempFilePath & TempFileName, Quality:=xlQualityStandard
wb.Close SaveChanges:=False

' Create the Outlook application and a new mail item
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

' Attach the combined PDF file to the email
With OutMail
.To = "MrX@Micro.com" ' Change this to the recipient's email address
.Subject = "Multiple Ranges as Single PDF"
.Body = "Please find the multiple ranges combined and attached as a single PDF."
.Attachments.Add TempFilePath & TempFileName
.Send
End With

' Delete the temporary PDF file
Kill TempFilePath & TempFileName

' Release objects from memory
Set OutMail = Nothing
Set OutApp = Nothing
Set wb = Nothing
Set ws = Nothing
Set rng1 = Nothing
Set rng2 = Nothing
Set combinedRange = Nothing

End Sub