0

I have a large report that I have to parse through and send emails to individuals based on the data in the report. I have created a macro that allows me to split the data I need into separate sheets within the workbook so that the sheet's are named based on who the data should be emailed to.

I am struggling with finding how to automate the next step so that, based on the title of the sheet (name of person not email address), an email is sent to that person.

Currently my workaround is another macro that saves all the different sheets as separate workbooks, but that still requires me to manually send emails with attachments. Perhaps there is an easier way to automate once I have all the sheets saved as separate files?

Sub parse_data()

    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer

    vcol = 5
    Set ws = sheets("Master")
    lr = ws.Cells(ws.rows.count, vcol).End(xlUp).row
    title = "A1:W1"
    titlerow = ws.Range(title).Cells(1).row
    icol = ws.Columns.count
    ws.Cells(1, icol) = "Unique"

    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" _
        And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.rows.count, icol).End(xlUp).offset(1) = ws.Cells(i, vcol)
        End If
    Next

    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).clear

    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""

        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            sheets.Add(after:=Worksheets(Worksheets.count)).name = myarr(i) & ""
        Else
            sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.count)
        End If

        ws.Range("A" & titlerow & ":A" & lr).EntireRow.copy sheets(myarr(i) & "").Range("A1")
        sheets(myarr(i) & "").Columns.AutoFit
    Next

    ws.AutoFilterMode = False
    ws.Activate

End Sub

Sub Splitbook()

    'Split worksheets into seperate saved files'

    Dim xPath As String
    xPath = ActiveWorkbook.path

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each xWs In ThisWorkbook.sheets
        xWs.copy
        ActiveWorkbook.SaveAs filename:=xPath & "\" & xWs.name & ".xlsx"
        ActiveWorkbook.Close False
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Any assistance is much appreciated. Thanks in advance!

braX
  • 11,506
  • 5
  • 20
  • 33
bezj
  • 93
  • 1
  • 2
  • 7
  • When you say the sheet is named based on who to send the email to, do you mean it has their actual name or their email address? – Marcucciboy2 Oct 17 '18 at 17:26
  • It'd help if you pasted your current code as well, because this problem isn't *too* difficult – Marcucciboy2 Oct 17 '18 at 17:26
  • If you want to go the route with each sheet as a separate file, you can attach that file to an email using something like this https://stackoverflow.com/a/37302823/2727437 – Marcucciboy2 Oct 17 '18 at 17:29
  • @Marcucciboy2 Posted code! The name of the separate sheets is the persons name not their email address currently. Checking your suggested link now. – bezj Oct 17 '18 at 17:35
  • Oh okay you were a little further back then I expected, check out Ron de Bruin's classic examples for creating outlook mail with excel vba https://www.rondebruin.nl/win/s1/outlook/mail.htm – Marcucciboy2 Oct 17 '18 at 17:42
  • Are you aware of the "mail merge" feature? https://support.office.com/en-us/article/mail-merge-using-an-excel-spreadsheet-858c7d7f-5cc0-4ba1-9a7b-0a948fa3d7d3 – Dominique Jun 07 '20 at 13:56

0 Answers0