Only running an action once per entry

bruty

Active Member
Joined
Jul 25, 2007
Messages
448
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
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Domski

Well-known Member
Joined
Jan 18, 2005
Messages
7,292
Maybe something like this:

Code:
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

Active Member
Joined
Jul 25, 2007
Messages
448
Brilliant - knew it would be something simple. Will try and stick this in my existing code and see what happens.

Many thanks
 

bruty

Active Member
Joined
Jul 25, 2007
Messages
448
Having a problem integrating the above code into my existing code - I'm just having a bad day lol

My existing code is:
Code:
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

Well-known Member
Joined
Jan 18, 2005
Messages
7,292

ADVERTISEMENT

Not tested but maybe:
Code:
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

Well-known Member
Joined
Jan 18, 2005
Messages
7,292
Sorry about the code not displaying properly. I'm having real problems posting to the forum today for some reason.

Dom
 

bruty

Active Member
Joined
Jul 25, 2007
Messages
448

ADVERTISEMENT

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

Thanks again :)
 

bruty

Active Member
Joined
Jul 25, 2007
Messages
448
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:
Code:
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

Well-known Member
Joined
Jan 18, 2005
Messages
7,292
I guessed that it was the email addresses that were duplicated. Is this correct?

Dom
 

Watch MrExcel Video

Forum statistics

Threads
1,127,205
Messages
5,623,364
Members
415,969
Latest member
Rey99

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top