Emailing from Excel - One Email Per Distinct Name - vba

Question

I have a worksheet that is sorted by name. Some names may have several rows worth of data, some may only be found on one row. I would like to go through this worksheet and pull 3 pieces of data from each row and use that data to construct the body of an email. And I only want to send one email per person.
So if the name on the following row matches the current row I don't want to send the email yet, I want to pull the 3 pieces of data I need from that row, and it to what was grabbed from the row above, and again evaluate if that is the final row for the person.
I am new to coding and have hit some "writer's block" in trying to overcome this issue. Any help would be appreciated.

Answer 1

I think I struggled because I was trying to do it in one Sub and it started to get too cluttered. Instead I broke it down into easier to follow pieces. Here is how I ultimately decided to solve this (I'm leaving out the sorting piece and a function that arranges the recipient's name):
Sub EDBRemitMain()
Dim lRowCount As Long
Dim lCount As Long
'First we will sort the data
Call EDBRemitSort
'Figure out how many rows of data the sheet has:
Range("A1").Select
Selection.End(xlDown).Select
lRowCount = ActiveCell.Row
'We will start on row 2 since the worksheet will always have a header row.
For lCount = 2 To lRowCount
Call EDBRemitEmailBody(lCount, lRowCount)
Next lCount
End Sub
Sub EDBRemitEmailBody(lCount As Long, lRowCount As Long)
Dim BodyEmail1
Dim BodyEmail2
Dim cRunningTotal As Currency
Dim sDate As String
Dim lTripNum As Long
Dim sCustomer As String
Dim cTotal As Currency
Dim sNameEval1 As String
Dim sNameEval2 As String
'Reset cRunningtotal
cRunningTotal = 0
'Run until there are no more rows of data.
Do Until lCount = lRowCount + 1
'Set the total amount, customer, trip number, and date we will use in the email's body, and update the running total.
sDate = Cells(lCount, 4)
sCustomer = Cells(lCount, 8)
cTotal = Cells(lCount, 29)
lTripNum = Cells(lCount, 1).Value
cRunningTotal = cRunningTotal + cTotal
'Start building the body of the email
BodyEmail1 = "Hello" & "<p>" & "You are being reimbursed for the following expenses, for which the total amount is <B>€" & cRunningTotal & "</B></p>"
BodyEmail2 = BodyEmail2 & "<p>" & sDate & " " & sCustomer & " " & "€" & cTotal & " " & "http://url/linking/to/a/detailed/BreakdownOfExpenses.aspx?TripID=" & lTripNum & "</p>"
'Set variables that we will use to see if the name in the next row matches the name on the current row.
Cells(lCount, 3).Activate
sNameEval1 = ActiveCell.Value
sNameEval2 = ActiveCell.Offset(1, 0)
If sNameEval1 <> sNameEval2 Then
Call EDBSendEmail(BodyEmail1, BodyEmail2, lCount)
Exit Sub
Else
End If
lCount = lCount + 1
Loop
End Sub
Sub EDBSendEmail(BodyEmail1, BodyEmail2, lCount)
Dim sName As String
Dim aOutlook As Object
Dim aEmail As Object
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'Grab the names we want to flip, feed it into our function and return
sName = FlipNames(Cells(lCount, 3).Value)
With aEmail
.Subject = "Trip Reimbursement"
.HTMLBody = BodyEmail1 & BodyEmail2
.To = sName
.BCC = "Person I am BCCing"
'For the test we will Display the emails rather than automatically sending them.
'.Display
.Send
End With
Set aOutlook = Nothing
End Sub