Create Email from Excel by Row with Attachments Based on Recipients Matching in Each Row

Question

not sure how to best title this, but I have a sheet from which I loop through each row and create an email for each row. Attachments are based on the Division name. Currently, it creates an email for every row, so if one person under Name has, say 8 divisions, they will receive 8 emails, each with a different attachment. This is annoying people, so I want to have it now loop (maybe nested?) and if if finds the same Name, then create one email for that Name, with all their Division reports attached.

To make it easier, I have set the list so that any dupe Names are all grouped together. In this example, I would want it to create one email to the Name Sample Sample1, with attachments for Widgets and Doorknobs. Then for the rest, they would each get their usual one email. I have tried for hours to get this to work, but simply do not have enough VBA knowledge to make this work. I can do it in Excel itself with formulas, basically saying that if A2=A3, then do this. But I need help to get this to happen in VBA. Please see the image.
Update: I have updatedthe below code I have put together using the factoring method shown to be by Vityata. It runs, but creates dupes of each email.

Option Explicit

Public Sub TestMe()

Dim name            As String
Dim division        As String
Dim mail            As String
Dim dict            As Object
Dim dictKey         As Variant
Dim rngCell         As Range

Set dict = CreateObject("Scripting.Dictionary")

For Each rngCell In Range("b2:b4")
    If Not dict.Exists(rngCell.Value) Then
        dict.Add rngCell.Value, rngCell.Offset(0, -1)
    End If
Next rngCell

For Each dictKey In dict.keys
    SendMail dictKey, dict(dictKey)
Next dictKey

End Sub

Public Sub SendMail(ByVal address As String, ByVal person As String)
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strdir As String
Dim strFilename As String
Dim sigString As String
Dim strBody As String
Dim strName As String
Dim strName1 As String
Dim strDept As String
Dim strName2 As String

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

sigString = Environ("appdata") & _
            "\Microsoft\Signatures\Test.htm"

            If Dir(sigString) <> "" Then
     signature = GetBoiler(sigString)
     Else
     signature = ""
    End If


strdir = "z:\"


strBody = "<Font Face=calibri>Please review the attached report for your department." 

For Each address In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

    If cell.Value Like "?*@?*.?*" And _
       LCase(Cells(cell.Row, "C").Value) = "yes" Then
        Set OutMail = OutApp.CreateItem(0)


    With OutMail
        strName = Cells(cell.Row, "a").Value
        strName1 = Cells(cell.Row, "d").Value
        strName2 = Left(strName, InStr(strName & " ", " ") - 1)
        strFilename = Dir("z:\*" & strName1 & "*")

            .To = cell.Value
            .Subject = "Monthly Budget Deficit Report for " & strName1
            .HTMLBody = "<Font Face=calibri>" & "Dear " & address & ",<br><br>"
            .Attachments.Add strdir & strFilename
            .Display  'Or use Send
    End With

        Set OutMail = Nothing
    End If
Next cell

End Sub



Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function

Answer 1

A question like this can be summarized to the following: How do I avoid duplicate values in VBA, as far as you do not want to send twice the same e-mail to the same address.

Thus, imagine the following data:

You do not want to send the email twice to Mr. Test and Mr. Test2. What is the alternative? Try to build a dictionary, as a key the unique mail column. Then refactor your code, sending code only to the people that "made it" to the dictionary. You need to refactor your code, thus at the end you get something like this:

Option Explicit

Public Sub TestMe()

    Dim name            As String
    Dim division        As String
    Dim mail            As String
    Dim dict            As Object
    Dim dictKey         As Variant
    Dim rngCell         As Range

    Set dict = CreateObject("Scripting.Dictionary")

    For Each rngCell In Range("C2:C6")
        If Not dict.exists(rngCell.Value) Then
            dict.Add rngCell.Value, rngCell.Offset(0, -1)
        End If
    Next rngCell

    For Each dictKey In dict.keys
        SendMail dictKey, dict(dictKey)
    Next dictKey

End Sub

Public Sub SendMail(ByVal address As String, ByVal person As String)
    Debug.Print "Mr./Mrs. " & person & ", here is your email -> " & address
End Sub

This is what you get:

Mr./Mrs. Test, here is your email -> test@t.t
Mr./Mrs. Test2, here is your email -> test2@t.t
Mr./Mrs. Test3, here is your email -> test3@t.t

The idea of the refactoring, is that you separate the "reading-from-Excel" logic from the "Send email" logic. In the "reading-from-Excel" logic you will only read those parts, which are unique and in the "Send email" you will send mail to anyone who has passed the reading logic.