Only running an action once per entry

[bruty]

I have some code that sends an email to the list of people in a selected range, but recently there have been duplicates in the range due to the way the data is keyed.

Is there any way of adding in some code that checks if the name has already been actioned and so skip that entry.

The email addresses are in column A and I just select the range I want (eg A2:A1500) then run the macro on that selection.

Hope someone understands this, as I don't think I've explained it very well.

Cheers,

bruty

 

[Domski]

Maybe something like this:

Dim rngLoopRange As Range

For Each rngLoopRange In Range("A2:A1500")
    If WorksheetFunction.CountIf(Range("A2", rngLoopRange), rngLoopRange.Value) = 1 Then
        'do something
    Else
        MsgBox "Already done for " & rngLoopRange.Value
    End If
Next rngLoopRange

You can skip the else and msgbox bit if you just want the code to run through.

Dom

 

[bruty]

Brilliant - knew it would be something simple. Will try and stick this in my existing code and see what happens.

Many thanks

 

[bruty]

Having a problem integrating the above code into my existing code - I'm just having a bad day lol

My existing code is:

Sub Send_emails()
    Dim crow
    Dim Response
    
    If Selection.Areas.Count > 1 Then
        MsgBox "Multiple selection areas are not supported"
        Exit Sub
    End If
    
    Lastrow = ActiveCell.row + Selection.Rows.Count - 1
    
    For crow = ActiveCell.row To Lastrow
        UserForm1.TextBox1 = crow
        UserForm1.Repaint
        
            'Gather some data to send to the email routine
            txtcontactname = Cells(crow, Range("ContactName").Column)
            txtcontactemail = Cells(crow, Range("ContactEmail").Column)
            txtTitle = Cells(crow, Range("ContactTitle").Column)
            txtSurname = Cells(crow, Range("Surname").Column)
            txtForename = Cells(crow, Range("Forename").Column)
            txtDoB = Cells(crow, Range("DOB").Column)
            txtNINo = Cells(crow, Range("NINo").Column)
            txtVType = Cells(crow, Range("VType").Column)
            txtS1Clear = Cells(crow, Range("Stage1Clear").Column)
            
            Call sendMail(txtcontactname, txtcontactemail, txtTitle, txtSurname, txtForename, txtDoB, txtNINo, txtVType, txtS1Clear, False)

        End If
    Next crow
    UserForm1.TextBox1 = "Emails sent"
End Sub

crow is the current row and I basically only want to call the sendMail once per email address in column A or Range("ContactEmail").Column. My mind is hitting a real blank so anyone who can help it would be greatly appreciated.

 

[Domski]

Not tested but maybe:

Sub Send_emails()    Dim crow As Long    Dim Firstrow As Long    Dim Lastrow As Long    If Selection.Areas.Count > 1 Then        MsgBox "Multiple selection areas are not supported"        Exit Sub    End If    Firstrow = ActiveCell.Row    Lastrow = ActiveCell.Row + Selection.Rows.Count - 1    For crow = Firstrow To Lastrow            UserForm1.TextBox1 = crow            UserForm1.Repaint        If WorksheetFunction.CountIf(Range(Cells(Firstrow, Range("ContactEmail").Column), _            Cells(Firstrow, Range("ContactEmail").Column)), Cells(Firstrow, _            Range("ContactEmail").Column).Value) = 1 Then            'Gather some data to send to the email routine            txtcontactname = Cells(crow, Range("ContactName").Column)            txtcontactemail = Cells(crow, Range("ContactEmail").Column)            txtTitle = Cells(crow, Range("ContactTitle").Column)            txtSurname = Cells(crow, Range("Surname").Column)            txtForename = Cells(crow, Range("Forename").Column)            txtDoB = Cells(crow, Range("DOB").Column)            txtNINo = Cells(crow, Range("NINo").Column)            txtVType = Cells(crow, Range("VType").Column)            txtS1Clear = Cells(crow, Range("Stage1Clear").Column)            Call SendMail(txtcontactname, txtcontactemail, txtTitle, txtSurname, txtForename, _            txtDoB, txtNINo, txtVType, txtS1Clear, False)        End If    End IfNext crowUserForm1.TextBox1 = "Emails sent"End Sub

Dom

 

[Domski]

Sorry about the code not displaying properly. I'm having real problems posting to the forum today for some reason.

Dom

 

[bruty]

No worries - I'll give it a go and let you know, but probably not until tomorrow.

Thanks again

 

[bruty]

Doesn't seem to be working for me - testing it with a message box instead of an email and it comes up for every cell selected including the duplicates.
It seems that the issue is in this line:

If WorksheetFunction.CountIf(Range(Cells(Firstrow, Range("ContactEmail").Column), Cells(Firstrow, Range("ContactEmail").Column)), Cells(Firstrow, Range("ContactEmail").Column).Value) = 1 Then

as that never increases past 1 when I add a watch on it.

Any advice?

 

[Domski]

I guessed that it was the email addresses that were duplicated. Is this correct?

Dom

 

[bruty]

That is correct