Creating and emailing Excel sheet with only visible data

mecerrato

Board Regular
Joined
Oct 5, 2015
Messages
184
Office Version
  1. 365
Platform
  1. Windows
I have this code that creates a copy of my excel sheet and puts it an email in outlook. this works perfectly.
However, I run a filter with a change event once a loan officer is chosen in cell and I would like to modify my macro to strip out all the other data so the user that receives the emailed sheet does not see the other loan officers data.
I am not sure how to accomplish this, can someone help me add the needed code?

VBA Code:
Sub Mail_workbook_Outlook()
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Set mysht = ThisWorkbook.Worksheets("Data")
Application.EnableEvents = False
If Range("B6").Value = "" Then
    MsgBox "Please select a loan officer", vbCritical, "Read me"
Else
Sheets("List").Visible = False
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
    Set wb1 = ActiveWorkbook
    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = Sheets("Data").Range("B6").Value & " Refi Opportunity List"
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
        '.to = ""
        .CC = ""
        .BCC = ""
        .Subject = Sheets("Data").Range("B6").Value & " Refi Opportunity List"
        '.Body = "Hello, see attached refi opportunity list"
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        .Display
    End With
    On Error GoTo 0
    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Worksheets("List").Visible = True
Application.EnableEvents = True
End If
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,223,933
Messages
6,175,473
Members
452,646
Latest member
tudou

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top