Sub one()
Dim outlookApp As Object
Dim outlookMail As Object
Dim mailBody As String
Dim rng As Range
Dim ws As Worksheet
Dim recipientsDict As Object
Dim recipientCell As Range
Dim recipientEmail As Variant ' Change the data type to Variant
' Set the worksheet where your data is located
Set ws = ThisWorkbook.Worksheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
lastColumn = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' Set the range of data (adjust the range as per your actual data)
Set rng = ws.Range(ws.Cells(2, 1), ws.Cells(lastRow, lastColumn)) ' Change the
range as needed
' Create a dictionary to store recipients' data
Set recipientsDict = CreateObject("Scripting.Dictionary")
' Loop through the data and group rows by recipient email
For Each Row In rng.Rows
recipientEmail = Row.Cells(2).Value
If Not recipientsDict.Exists(recipientEmail) Then
recipientsDict(recipientEmail) = ""
End If
recipientsDict(recipientEmail) = recipientsDict(recipientEmail) &
"<tr><td>" & Row.Cells(1).Value & "</td><td>" & Row.Cells(2).Value & "</td><td>" &
Row.Cells(3).Value & "</td><td>" & Row.Cells(4).Value & "</td><td>" &
Row.Cells(5).Value & "</td><td>" & Row.Cells(6).Value & "</td><td>" &
Row.Cells(7).Value & "</td><td>" & Row.Cells(8).Value & "</td></tr>"
Next Row
' Create an Outlook instance
Set outlookApp = CreateObject("Outlook.Application")
' Loop through each recipient and send an email with the data table
For Each recipientEmail In recipientsDict.Keys
' Create the table in mail body
mailBody = "<html><body>" & _
"<div style='font-family: Arial, sans-serif; font-size: 14px;'>"
& _
"<p style='color: #0056b3;'>Dear Sir/Madam,</p>" & _
"<p>Are you looking to enhance efficiency and drive growth in
your NBFC or Financial Institution?</p>" & _
"<p style='color: #28a745;'>Discover how our Finance ERP
Software can revolutionize your financial management:</p>" & _
"<ul>" & _
"<li>Effortless Compliance: Stay compliant with regulatory
requirements.</li>" & _
"<li>Customizable Solutions: Tailor the software to fit your
institution's needs.</li>" & _
"<li>Seamless Integration: KYC, CIBIL, NAACH, and Bank
integrations with a few clicks.</li>" & _
"</ul>" & _
"<p style='color: #dc3545;'>Boost your operations with Growth
ERP:</p>" & _
"<img src='https://example.com/your-image.jpg' alt='Growth ERP'
style='width: 300px; height: auto;'><br>" & _
"<p>Experience the power of Growth ERP with a personalized
demo.</p>" & _
"<p style='font-weight: bold;'>Contact us to elevate your
financial management capabilities!</p>" & _
"<p>Best regards,<br>Sachin Shukla<br>6375615933<br>Growth ERP -
Leading NBFC ERP</p>" & _
"</div></body></html>"
' Create an email message
Set outlookMail = outlookApp.CreateItem(0)
' Compose the email
With outlookMail
.To = recipientEmail
.Cc = "growthsystem.marketing01@gmail.com"
.Subject = "Automate your NBFC to take to 100x Potential"
.HTMLBody = mailBody
.Importance = 2
.Send ' Use .Send instead of .Display to directly send the email
End With
' Clean up
Set outlookMail = Nothing
Next recipientEmail
' Clean up
Set outlookApp = Nothing
End Sub
