1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User


  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Email issue on duplicate email address

Discussion in 'VBA Macros' started by Madz1101, Jan 9, 2019.

  1. Madz1101

    Madz1101 New Member

    Below is code i am using to send email. It is working fine as long as the column C doesn't have any duplicate email in it. Outlook doesn't open for duplicate email.

    I am not very good at VBA and i have written this code with alot of help and searching from internet.

    Can anyone please see why on duplicate email outlook is not opening?


    Code (vb):

    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, 16) = "Yes" Then

    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Some text here"
    On Error Resume Next

    With xOutMail
    .To = Cells(cell.Row, 3)
    .CC = Cells(cell.Row, 6) & "; " & Cells(cell.Row, 11)
    .BCC = ""
    .Subject = "Subject"
    .Body = xMailBody
    '.Attachments.Add ActiveWorkbook.FullName
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing

    Cells(cell.Row, 16).Value = "No"

    Last edited: Jan 9, 2019
  2. Deepak

    Deepak Excel Ninja


    Below line is checking that email will not send to any email duplicate email in said range on each loop.

    Code (vb):
    If WorksheetFunction.CountIf(Range("C8:C" & cell.Row), cell) = 1 Then
    What you want in case of multiple existence...
    • Send email to all if duplicate - then just remove that line and end if .
    • Or something else then let us know with complete code as u might not able to alter the suggestion provided here due to novoice.
    Madz1101 likes this.
  3. Madz1101

    Madz1101 New Member

    Thanks Deepak. I removed the line you mentioned and email is being sent as desired.

    Thank you so much

Share This Page