email sections of worksheet to different email addresses

I have a workbook which contains a sheet with a dept number column and a sheet with dept #s and email addresses. I need code to create an email for each department which contains only that department's data. i've attached a sample workbook. so, for rows containining department 606 or 607, i'd need an email to go to pam.white@lpnt.net (one email to pam white for dept 606 data and a separate email to pam white for 607 data). for 608, email pdeshazier@yahoo.com. thanks in advance for any assistance!! :hi:

What is the subject? What is the body? IF the data is not in the body, would data be an Excel file attachment with just with their data? IF the data is not in the body, would data be a PDF file attachment with just with their data?

thanks for responding. The subject will likely be populated from the file name OR file name with "yesterday's" date concatenated.

The body - i had planned on it being the data on each row. Our controller is concerned about outputting data in excel for fear of it being changed, though i've tried convincing her we can protect it so that it can't be modified. the only thing i'm unsure of there is whether they can make a copy of a protected workbook, save it and then modify the copy. if not, i favor sending in excel rather than .pdf (which is the direction my controller was going bc pdf cant' be modified). so.... currently, going with controller's preference, attached .pdf file. however, as long as whatever we DO send cannot be modified, i feel our CFO will be okay with any of these solutions.

Quote:

---

Originally Posted by Kenneth Hobs

What is the subject? What is the body? IF the data is not in the body, would data be an Excel file attachment with just with their data? IF the data is not in the body, would data be a PDF file attachment with just with their data?

---

I have a report at work, which I have to send out to multiple people depending on certain values in a column. I understand how time consuming this is... That's why I too decided to write a macro for this!!

This is pretty much the same as what you are describing.
I got bits and pieces of the code from various sources online, but it's a mixture of various codes put together to achieve the result.
I cannot remember the code off the top of my head.
So it sounds this is exactly the same as what you want to do... I'll try to remember to email home and then modify it to suit your needs.
That's if this isn't resolved before then :)

pdeshazier,

This should do what you need, save the range to pdf then email off. This is dependent on each of the departments listed in the array existing in the worksheet and being sorted according to the array. Someone else might have a cleaner way but this is what I use changed some to fit this specific sheet.

Code:

---

Sub emailpam()

    Dim OutApp, OutMail As Object
    Dim Dept, DSplit As Variant
    Dim eAddress, FName As String
    Dim FirstRow, LastRow, EMR As Integer
    Dim rng As Range
   
    Dept = Array(606, 607, 608)
       
    Set OutApp = CreateObject("Outlook.Application")
   
    'Set the first and last row to the first row of your data
    FirstRow = 2
    LastRow = 2
   
    'Split your data out as the filename can not have / in it.
    DSplit = Split(Date - 1, "/")
   
    With ActiveWorkbook.Worksheets(1)
   
    For Each i In Dept
        FirstRow = LastRow 'reset the first row of data to where the last ended.
        'loop through matching cells to find the last row of this specific department
        Do Until .Cells.Range("A" & LastRow).Value <> i
            LastRow = LastRow + 1
        Loop
        'set range of department with headers
        Set rng = Range("A1:H1,A" & FirstRow & ":H" & LastRow - 1)
        'set the pdf file name
        FName = "z:\test\Dept_" & i & "(" & DSplit(2) & "-" & DSplit(0) & "-" & DSplit(1) & ").pdf"
        'save pdf. this needs a different range as it does not need the headers listed separately
        Range("A" & FirstRow & ":H" & LastRow - 1).ExportAsFixedFormat xlTypePDF, Filename:=FName
        'create the email
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            EMR = 1 'row where the emails address start.
            'loop through email worksheet to find correct department
            Do Until ActiveWorkbook.Worksheets(2).Cells.Range("A" & EMR).Value = i
                EMR = EMR + 1
            Loop
            'grab email address
            eAddress = ActiveWorkbook.Worksheets(2).Cells.Range("B" & EMR).Value
            .To = eAddress
            'i set the subject to the pdf file name but you can easily change this to the excel workbook name
            .Subject = "Dept_" & i & "(" & DSplit(2) & "-" & DSplit(0) & "-" & DSplit(1) & ")"
            'add pdf
            .Attachments.Add FName
            .Send
        End With
    Next
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

---

mike

mike,Works brilliantly. Thanks for sharing.BigDawg15

thanks!!!!! i will give this a try!

Hi Mike,

Im just reviewing your code and im confused based on the earlier comments, does your code attach as an excel workbook/PDF or contains the details in the main body?

Amy