Need macro to send email with custom range

sfall

New Member
Joined
Jan 27, 2005
Messages
2
A very simple example of the spreadsheet I am working with:


COMPANY INVOICE EMAIL
ABC Truck F1334 Mike@abc.com
ABC Truck F1244 Mike@abc.com
ABC Truck F1254 Mike@abc.com
A1 Freight F1543 Steve@a1.com
B&G Truck F1555 Bob@BG.com
B&G Truck F1556 Bob@BG.com

I have a macro that will send one email per line so that they get a seperate notice of each invoice but but there can be hundreds of lines per email address per day that need to be sent so I want it to group all lines for each company onto a single email so that in this example it would send 3 instead of 6.

I'm looking for a way to find all occurences of the same company name and paste that range into the body of the email but I can't figure it out.
(Prefereably it would only show cells that are not hidded or that I can specify in the macro but I'll take the whole row if that's all I can get...)

Any help or direction at all would be GREAT!!
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).

Norie

Well-known Member
Joined
Apr 28, 2004
Messages
76,318
Office Version
  1. 365
Platform
  1. Windows
Can you post all the code you currently have?
 

sfall

New Member
Joined
Jan 27, 2005
Messages
2
Here is what I currently have. I want to add a loop within the body of the email that will continue to find occurences of the same company name and add those lines OR something that will identify the range that includes all of the same company name and paste those lines into the body of the email. Either way it needs to continue through the full list until an emails is sent to each company. Those are my ideas but I'm open to suggestions if there is a better way!

Code:
Sub TestFile()
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim cell As Range
 
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
 
    On Error GoTo cleanup
    For Each cell In Sheets("Daily Error Report").Columns("L").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Offset(0, 1).Value = "" Then
            If cell.Value Like "*@*" And Dir(cell.Offset(0, 0).Value) = "" Then
                Set OutMail = OutApp.CreateItem(olMailItem)
                With OutMail
                    .To = cell.Value
                    .Subject = "Invoice reports"
                    .Body = "The following invoices were processed today" & newline_
                    .Body = cell.Offset(0, -6).Value & "  -  " & cell.Offset(0, -2).Value
                    .Send
                End With
                Set OutMail = Nothing
            End If
        End If
    Next cell
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
 

Forum statistics

Threads
1,147,508
Messages
5,741,572
Members
423,668
Latest member
Audorin

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
Top