cells.find
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 |
cells.find
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 |
All times are GMT +1. The time now is 07:46 AM. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com