Emailing a filtered Range to managers

[EliseFreedman]

Hi There

I have a report which lists employees training status's. I am trying to expand the report to email each employees manager with a list of their employees who have failed to complete training

Using the code below, I have managed to extract the relevant rows in the spreadsheet and copy and paste the rows into the body of an email to send to the relevant manager (Manager Names and email addresses are listed in a separate sheet)

My issue is that the first two columns of the filtered spreadsheet contain the manager name and email address. Obviously this is needed for filtering the relevant rows but I would like to be able to hide those two columns before the email is sent out.

Also I would like to be able to add a paragraph explaining what the report is and what action the managers need to take.

How would I achieve these two things? Ive been trying all afternoon with no luck

Sub EmailFilteredRange(ByVal Recipient As String, ByVal Subject As String)

  ' Written: October 24, 2013
  ' Author:  Leith Ross
  ' Summary: Emails a filtered range in HTML format using Outlook.
    
    Dim Area     As Range
    Dim cnt      As Long
    Dim Data()   As Byte
    Dim HTMLcode As String
    Dim olApp    As Object
    Dim Rng      As Range
    Dim TempFile As String
    Dim Wks      As Worksheet
    
      ' Get all of the cells in the filter area.
        Set Rng = Sheet9.Range("A1").CurrentRegion
        
      ' Include the sub total row.
        Set Rng = Rng.Resize(Rng.Rows.Count + 2)
        
      ' Get cells only filtered cells and sub total row.
        Set Rng = Intersect(Rng, Sheet9.Cells.SpecialCells(xlCellTypeVisible))
    
          ' Copy the worksheet to create a new workbook.
            Sheet9.Copy
            Set Wks = ActiveSheet
            
          ' Turn off the AutoFilters.
            Wks.AutoFilterMode = False
        
          ' Clear the new worksheet except for the header row.
            Wks.UsedRange.Offset(1, 0).ClearContents
            
          ' Create a contiguous range on the new worksheet to be emailed.
            For Each Area In Rng.Areas
                Wks.Range("A1").Offset(cnt, 0).Resize(Area.Rows.Count, Area.Columns.Count).Value = Area.Value
                cnt = cnt + Area.Rows.Count
            Next Area
        
          ' This is the contiguous range of cells to email.
            Set Rng = Wks.Range("A1").CurrentRegion
            Set Rng = Rng.Resize(RowSize:=Rng.Rows.Count + 2)
            
            
              ' The new workbook will be saved to the user's Temp directoy
                TempFile = Environ("Temp") & "\" & Wks.Name & ".htm"
     
              ' If a file by this exists then delete it
                If Dir(TempFile) <> "" Then Kill TempFile
           
              ' Convert the new worksheet into an HTML file.
                With Wks.Parent.PublishObjects
                    .Add(SourceType:=xlSourceRange, _
                         Filename:=TempFile, Sheet:=Wks.Name, _
                         Source:=Rng.Address, HtmlType:=xlHtmlStatic) _
                    .Publish Create:=True
                End With
       
              ' Read the TempFile back as a byte array.
                Open TempFile For Binary Access Read As #1
                    ReDim Data(LOF(1))
                    Get #1, , Data
                Close #1
            
              ' Convert the byte array into a VBA string.
                HTMLcode = StrConv(Data, vbUnicode)
            
          ' Close the new workbook.
            Wks.Parent.Close SaveChanges:=False
          
          ' Change the HTML code to align the output on the left side of the page.
            HTMLcode = VBA.Replace(HTMLcode, "align=center x:publishsource=", "align=left x:publishsource=")
                      
      ' Start Outlook and send the email.
        Set olApp = CreateObject("Outlook.Application")
        olApp.Session.GetDefaultFolder (6)
        
        With olApp.CreateItem(0)
            .To = Recipient
            .Subject = Subject
            .BodyFormat = 2
            .HTMLBody = HTMLcode
            .Send
        End With

End Sub

Sub SendEmails()

    Dim Cell As Range
    Dim Rng As Range
    Dim Subj As String
    Dim Wks As Worksheet
    
      ' Change this to what you want the subject line to be.
        Subj = "This is subject line of the email."
        
        Set Wks = Sheet8
        Wks.AutoFilterMode = False
        
        Set Rng = Wks.Range("A2")
        LastRow = Wks.Cells(Rows.Count, "A").End(xlUp).Row
        If LastRow < Rng.Row Then Exit Sub
        
        Set Rng = Rng.Resize(RowSize:=LastRow - Rng.Row + 1)
        
            For Each Cell In Rng
                If Cell.Offset(0, 1) <> "" Then
                    Sheet9.AutoFilterMode = False
                    Sheet9.UsedRange.AutoFilter Field:=1, Criteria1:=Cell.Value, VisibleDropDown:=True
                    Call EmailFilteredRange(Cell.Offset(0, 1).Text, Subj)
                Else
                    MsgBox Cell & " has No Email Address.", vbExclamation
                End If
            Next Cell
        
End Sub

 

[SkipVought]

HI,

Why not copy the data without the two unwanted columns rather than trying to hide the columns?

I fail to understand what the issue is with item #2, the extra paragraph???

Skip,

_{Just traded in my OLD subtlety...
for a NUance!}