I have a problem when running this code, if there is no value "over due" in
the sheet i keep on getting an error. I need it to work also when nothing is
found.
can anyone help?

Sub sendemail()

Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer
Dim myRecipient As String
Dim myFirstCellAdd
Dim myCounter As Integer

myCounter = 0
Range("AE1").Select
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Do Until ActiveCell.Address = myFirstCellAdd
myCounter = myCounter + 1
myCurrAdd = ActiveCell.Address
If myCounter = 1 Then myFirstCellAdd = ActiveCell.Address
myRow = ActiveCell.Row
ActiveSheet.Range("AE" & myRow).Select

Application.ScreenUpdating = False

For myLoop = 1 To 3000
If ActiveCell.Value = "" Then myBodyText = myBodyText & "" &
ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
If ActiveCell.Column = 1 Then myRecipient = ActiveCell.Value
If ActiveCell.Column = 3001 Then myBodyText = myBodyText Else
ActiveCell.Offset(0, 1).Select
Next
ActiveSheet.Range(myCurrAdd).Select

Set OutlookApp = CreateObject("Outlook.Application")
With OutlookApp.CreateItem(olMailItem)
.Subject = "Event Remainder"
.Body = Range("C" & myRow).Value & " " & Range("B" & myRow).Value &
" row " & Range("A" & myRow).Value
'e-mail adress as in the mail culumn
.To = Range("AF" & myRow).Value
.CC = Range("AG" & myRow).Value
.Send
'this will change the value of cell so no more mails will be sent for
this event
Range("AE" & myRow).Value = "Noted"
End With
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Loop
MsgBox (myCounter)
Application.ScreenUpdating = False

End Sub

When you try to .Activate a cell that isn't there, you'll get this error.

Instead, you could use this construct:

Dim FoundCell as range

with activesheet
set foundcell = .cells.find(what:=.....

if foundcell is nothing then
'not found
else
'it's there
end if
end with



ZR wrote:

I have a problem when running this code, if there is no value "over due" in
the sheet i keep on getting an error. I need it to work also when nothing is
found.
can anyone help?

Sub sendemail()

Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer
Dim myRecipient As String
Dim myFirstCellAdd
Dim myCounter As Integer

myCounter = 0
Range("AE1").Select
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Do Until ActiveCell.Address = myFirstCellAdd
myCounter = myCounter + 1
myCurrAdd = ActiveCell.Address
If myCounter = 1 Then myFirstCellAdd = ActiveCell.Address
myRow = ActiveCell.Row
ActiveSheet.Range("AE" & myRow).Select

Application.ScreenUpdating = False

For myLoop = 1 To 3000
If ActiveCell.Value = "" Then myBodyText = myBodyText & "" &
ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
If ActiveCell.Column = 1 Then myRecipient = ActiveCell.Value
If ActiveCell.Column = 3001 Then myBodyText = myBodyText Else
ActiveCell.Offset(0, 1).Select
Next
ActiveSheet.Range(myCurrAdd).Select

Set OutlookApp = CreateObject("Outlook.Application")
With OutlookApp.CreateItem(olMailItem)
.Subject = "Event Remainder"
.Body = Range("C" & myRow).Value & " " & Range("B" & myRow).Value &
" row " & Range("A" & myRow).Value
'e-mail adress as in the mail culumn
.To = Range("AF" & myRow).Value
.CC = Range("AG" & myRow).Value
.Send
'this will change the value of cell so no more mails will be sent for
this event
Range("AE" & myRow).Value = "Noted"
End With
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Loop
MsgBox (myCounter)
Application.ScreenUpdating = False

End Sub

--

Dave Peterson