如果收件人电子邮件相同，则合并电子邮件主题和正文

Question

I am using below code to send email from excel when user press the button. it works fine. i actually want to fine tune this because right now what is happening is when in Column C there is a duplicate email and in column N it is all yes separate emails are generated. what i want to do is if there is a duplicate email in column C one email should be generated with subject and body from the duplicate rows

Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
'On Error Resume Next

LastRow = Range("C" & Rows.Count).End(xlUp).Row
For Each Cell In Range("C8:C" & LastRow)
If WorksheetFunction.CountIf(Range("C8:C" & Cell.Row), Cell) = 1 Then
If Cells(Cell.Row, 14) = "Yes" Then

Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Dear " & Cells(Cell.Row, 2) & vbNewLine & vbNewLine & _
            Cells(Cell.Row, 7) & " " & Cells(Cell.Row, 6) & vbNewLine & _
          "were issue to you for project " & Cells(Cell.Row, 8) & vbNewLine & vbNewLine & vbNewLine & vbNewLine & _
          "This is a system generated email and doesn't require signature"
              On Error Resume Next
With xOutMail
    .To = Cells(Cell.Row, 3)
    .CC = Cells(Cell.Row, 5)
    .BCC = ""
    .Subject = Cells(Cell.Row, 7) & " " & Cells(Cell.Row, 6) & " Issued to " & Cells(Cell.Row, 4)
    .Body = xMailBody
    '.Attachments.Add ActiveWorkbook.FullName
    .Display
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End If
End If
Next Cell

Answer 1

You can try:

Option Explicit

Public Sub Get_Unique_Count_Paste_Array()

    Dim Ob As Object
    Dim rng As Range
    Dim LR As Long
    Dim str As String

    With Worksheets("Sheet1")

        LR = .Range("C" & Rows.Count).End(xlUp).Row

        Set Ob = CreateObject("scripting.dictionary")

        For Each rng In .Range("C8:C" & LR)
            str = Trim(rng.Value)
            If Len(str) > 0 Then
                Ob(str) = Ob(str) + 1
                    If Ob(str) = 1 Then '<= Check how many times email address appears in the array & if it s appears only one time then..
                        MsgBox str '<= Insert your code here
                    End If
            End If
        Next rng

    End With

End Sub