I am trying to run the same routine in multiple worksheets. I have used many of the suggestions I found here and on other sites but it is still not working. I am trying to get the routine to identify where Cell C94 (on several worksheets) is greater than or equal to zero and send an email to notify managers. It does it fine until it runs into one sheet that meets the criteria, then stops. I need it to continue because there are other sheets that meet the criteria. In my email sub routine do I need to somehow send it back to the calculate routine after it sends and email?
Option Explicit
Sub Activate_Workbook_Never_Fail()
'Activate Workbook
Workbooks("The Never Fail Template.xlsm").Activate
End Sub
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double
Dim Sheet As String
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
If Sheet.Range("C94").Value <> "0" Then
Call Mail_small_Text_Outlook
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim rng As Range
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Auto Generated from the Never Fail Template" & vbNewLine & _
" " & vbNewLine & _
"The Direct Cite/Reimbursable Check is Out of Balance For Tab " & Range("C1").Value & vbNewLine & _
"Out of Balance by " & Range("C94").Value
On Error Resume Next
With OutMail
.To = "lawrence.monaco@navy.mil"
.Subject = "Out of Balance For Tab " & Range("C1").Value
.Body = strbody
'.Attachments.Add ("C:\test.txt")
.display
Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
MsgBox "Notification of Out of Balance Status Sent to Larry Monaco and Linda Robertson"
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Option Explicit
Sub Activate_Workbook_Never_Fail()
'Activate Workbook
Workbooks("The Never Fail Template.xlsm").Activate
End Sub
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim FormulaRange As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim MyLimit As Double
Dim Sheet As String
Dim Current As Worksheet
' Loop through all of the worksheets in the active workbook.
For Each Current In Worksheets
If Sheet.Range("C94").Value <> "0" Then
Call Mail_small_Text_Outlook
' This line displays the worksheet name in a message box.
MsgBox Current.Name
Next
End Sub
Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim rng As Range
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Auto Generated from the Never Fail Template" & vbNewLine & _
" " & vbNewLine & _
"The Direct Cite/Reimbursable Check is Out of Balance For Tab " & Range("C1").Value & vbNewLine & _
"Out of Balance by " & Range("C94").Value
On Error Resume Next
With OutMail
.To = "lawrence.monaco@navy.mil"
.Subject = "Out of Balance For Tab " & Range("C1").Value
.Body = strbody
'.Attachments.Add ("C:\test.txt")
.display
Application.Wait (Now + TimeValue("0:00:03"))
Application.SendKeys "%s"
MsgBox "Notification of Out of Balance Status Sent to Larry Monaco and Linda Robertson"
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub