set a reference in the IDE to Miscrosoft Scripting Runtime
We'll use a scripting Dictionary to save the addresses to
which we're sending. The advantage of this dictionary
versus a collection is that we can test if a "key" aleady
exists.
So there are two dims and a couple of changes to make, as
follows:

Sub SendEmailRoutine()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim cell As Range

Dim addresslist As Scripting.Dictionary ' NEW
Dim sAddress As String 'NEW
Set addresslist = New Scripting.Dictionary 'NEW


Application.ScreenUpdating = False
Set olApp = New Outlook.Application
For Each cell In Sheets("Sheet1").Columns
("F").Cells.SpecialCells(xlCellTypeConstants)
sAddress = cell.Value
If cell.Offset(0, 1).Value < "" Then

If sAddress Like "*" And cell.Offset(0,
1).Value = "5" Then ' CHANGE
addresslist.Add sAddress, sAddress 'NEW

If Not addresslist.Exists(sAddress) Then'NEW
Set olMail = olApp.CreateItem
(olMailItem)
With olMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & cell.Value &
vbNewLine & vbNewLine & _
"You have an action due
in 5 days! Please contact us."
.Send 'Or use Display
End With
Set olMail = Nothing
End If

End If ' NEW

End If
Next cell
Set olApp = Nothing
Application.ScreenUpdating = True
End Sub





Patrick Molloy
Microsoft Excel MVP

-----Original Message-----
Hello all,

I was looking at some of Ron's email code on his
website. I tested a few and they worked great. I am
interested in this code found he Mail a message to
each person in a range (Outlook only)
http://www.rondebruin.nl/sendmail.htm#message

I have a question though. The code looks in a column
and emails everyone in it. I'm trying to have an
automated emailing list but the problem I have is that in
my spreadsheet we have names repeated a lot. I dont want
the person getting 10-20 emails that say the same thing.
Does anyone have any idea to make it so that the person
on the list will get emailed only once? need some
brainstorming.

The code in the link above will just loop down the
column and email people regardless of who they are. My
code has been changed a bit and instead of looking for a
yes, it looks for "5" (as in 5 days remaining till an
action is due).

Sub SendEmailRoutine()
Dim olApp As Outlook.Application
Dim olMail As MailItem
Dim cell As Range
Application.ScreenUpdating = False
Set olApp = New Outlook.Application
For Each cell In Sheets("Sheet1").Columns
("F").Cells.SpecialCells(xlCellTypeConstants)
If cell.Offset(0, 1).Value < "" Then
If cell.Value Like "*" And cell.Offset(0,
1).Value = "5" Then
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = cell.Value
.Subject = "Reminder"
.Body = "Dear " & cell.Value &
vbNewLine & vbNewLine & _
"You have an action due in 5
days! Please contact us."
.Send 'Or use Display
End With
Set olMail = Nothing
End If
End If
Next cell
Set olApp = Nothing
Application.ScreenUpdating = True
End Sub


Thanks,
Lobo




.