Send email together based on organisation on my excel list

[VBAEXCELNew]

Hello there,

Currently i have done my vba script where if user click on the marco it will be send out based on the list given 1 by 1, now i have a new scenario where if the organisation below together, how can i send out 1 time instead of 1 by 1 ?

Here my vba script that i have written

Sub SendEmails()

If ActiveSheet.Name <> "Master Table" Then Exit Sub


Dim Applications As Object
Set Applications = CreateObject("Outlook.Application")

Dim Applications_Item As Object

Set Applications_Item = Applications.CreateItem(0)

Dim Rlist As Range

'Set Rlist = Range("A2", Range("a2").End(xlDown))
Set Rlist = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Cells

Dim R As Range

For Each R In Rlist

Set Applications_Item = Applications.CreateItem(0)

HtmlContent = "<table>"
    HtmlContent = "<br><table border=1><tbody>"
  
    'strQuotation = Trim(ThisWorkbook.Sheets("Master Table").Range("B" & R.Offset(0, 1)).Text)
    
    HtmlContent = HtmlContent & "<tr><th>Quotation / DC No.:</th><td>" & R.Offset(0, 1) & "</td></tr>"
    HtmlContent = HtmlContent & "<tr><th>Description:</th><td>" & R.Offset(0, 2) & "</td></tr> "
    HtmlContent = HtmlContent & "<tr><th>Status:</th><td>" & "Error Message: " & R.Offset(0, 0) & "<br>" & "Remarks 1: " & R.Offset(0, 5) & "<br>" & "Remarks 2: " & R.Offset(0, 6) & "<br>" & "Remarks 3: " & R.Offset(0, 7) & "</td></tr>"
    HtmlContent = HtmlContent & "<tr><th>Remarks:</th> <td>" & R.Offset(0, 8) & "</td></tr>"
    

HtmlContent = HtmlContent & "</tbody></table>"

With Applications_Item
    
    .To = R.Offset(0, 9)
    .CC = R.Offset(0, 10)
    .Subject = R.Offset(0, 1) & " Requires Your Attention - " & R.Offset(0, 0)
    '.Body = "Dear Buyer/AM, " & vbNewLine & vbNewLine & "We would like to inform that the following requires your attention." & vbNewLine & vbNewLine
    .HTMLBody = "Dear Buyer/AM, <br> <br>" & "We would like to inform that the following requires your attention.<br>" & HtmlContent & "<br> <br> Should you require further clarification, please contact your respective Finance Partners: <br> Thank you."
    .Display
    ' Send out email out
    '.Send
    
    End With
    
Next R

Set Applications = Nothing
Set Applications_Item = Nothing


'Only for setup reference if u select the outlook library else multiple computer wouldnt work without setup
'Dim EApp As Outlook.Application
'Set EApp = New Outlook.Application
'
'Dim EItem As Outlook.MailItem
'Set EItem = EApp.CreateItem(olMailItem)

End Sub

New scenario to add on (organisation for schools)

how can i say if this organisation column if they contain the same school, they be included to a 1 email ?

 

[Fluff]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Vba to send email if name is the same?
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.