Looping and Filtering in VBA

[southcali12]

Hi Everyone,

I am sending out Outlook appointments via a spreadsheet where all the data/information is stored. However, the issue I am running into is: when I need to send out multiple information to the same email address for a client, I want the client to get all of the information in the one appointment's body, and not send out out X amount of emails to the same client with different information.

For example in the sample below, I'd want the rows with Alaska-5 to be sent in one appointment body, and the row with Alaska-6 to be sent in another appointment body.

Example of what spreadsheet looks like (the other columns are filled with other information):

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Column D[/TD]
[TD]Column G[/TD]
[TD]Column H[/TD]
[TD]Column I[/TD]
[TD]Column K[/TD]
[TD]Column N[/TD]
[TD]Column O[/TD]
[TD]Column P[/TD]
[TD]Column Q[/TD]
[/TR]
[TR]
[TD]Site[/TD]
[TD]Client[/TD]
[TD]Supervisor[/TD]
[TD]Date[/TD]
[TD]Client Time[/TD]
[TD]Client Ticket[/TD]
[TD]Site Email[/TD]
[TD]Appointment Start[/TD]
[TD]Phone Number[/TD]
[/TR]
[TR]
[TD]Alaska-5[/TD]
[TD]Doe,John[/TD]
[TD]Adam,Joe[/TD]
[TD]11/8/2015[/TD]
[TD]1500[/TD]
[TD]123456[/TD]
[TD]Alaska-5@123.com[/TD]
[TD]11/8/2015 15:00[/TD]
[TD](800)123-4567[/TD]
[/TR]
[TR]
[TD]Alaska-6[/TD]
[TD]Smith,Mary[/TD]
[TD][TABLE="width: 71"]
<tbody>[TR]
[TD="width: 71"]Smith,John[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl65, width: 69, align: right"]11/8/2015[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 74"]
<tbody>[TR]
[TD="width: 74, align: right"]1900[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]3456789[/TD]
[TD]Alaska-6@123.com[/TD]
[TD]11/8/2015 15:30[/TD]
[TD](800)123-4567[/TD]
[/TR]
[TR]
[TD]Alaska-5[/TD]
[TD]White,Betty[/TD]
[TD]Adam,Joe[/TD]
[TD][TABLE="width: 69"]
<tbody>[TR]
[TD="class: xl65, width: 69, align: right"]11/8/2015[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][TABLE="width: 74"]
<tbody>[TR]
[TD="width: 74"]1530[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]564897[/TD]
[TD]Alaska-5@123.com[/TD]
[TD]11/8/2015 17:00[/TD]
[TD](800)123-4567[/TD]
[/TR]
</tbody>[/TABLE]


Code:
Sub SetAppt()
'Want it to filter by site and hour, and send out one appointment per site/hour
Dim olApt As Object
Dim olApp As Object
Dim i As Long
Dim apptRange As Variant

Const olAppointmentItem As Long = 1
Set olApp = GetOutlookApp

' read appts into array
apptRange = Range(Cells(2, 1), Cells(Rows.Count, 17).End(xlUp)).Value

For i = LBound(apptRange) To UBound(apptRange)
Set olApt = olApp.CreateItem(olAppointmentItem)
With olApt
.RequiredAttendees = apptRange(i, 15)
.Start = apptRange(i, 16)
.Duration = "60"
.Subject = "Subject"
.body = "Hello " & apptRange(i, 4) & "," & vbCrLf & vbCrLf & "Looking forward to speaking with you:" & vbCrLf & vbCrLf & _
"Client: " & vbCrLf & "Time: " & apptRange(i, 10) & vbCrLf & "Date: " & apptRange(i, 9) & vbCrLf & vbCrLf & _
"Phone Number: " & apptRange(i, 17) & vbCrLf & vbCrLf & _
.BusyStatus = olBusy
.ReminderMinutesBeforeStart = "30"
.ReminderSet = True
.Importance = olImportanceHigh
.display
End With

Next

End Sub
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = CreateObject("Outlook.Application")
End Function

 

[CharlesChuckieCharles]

sorting the data by site and hour as a start would be useful

Then just track that changes in the values that matter to you

ThisSite=""
ThisHour=""

For i = LBound(apptRange) To UBound(apptRange)
If ThisSite<>apptRange(i,4) or ThisHour<> apptRange(i,15) and ThisSite<>"" then 
.display  ' as in send the appointment
ThisSite=apptRange(i,4)
ThisHour = apptRange(i,15)
endif
now start processing the next appointment

at the end after the loop

.display to send the last email