Run same routine in several worksheets

[Monaco]

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

 

[yky]

Are you talking about the C1 and C94 in the following code? So, you want them to be updated, right?

[COLOR=#333333]"The Direct Cite/Reimbursable Check is Out of Balance For Tab " & Range("C1").Value & vbNewLine & _[/COLOR]
[COLOR=#333333]"Out of Balance by " & Range("C94").Value[/COLOR]

There are several ways to do it. You can declare Current right below the first line "Option Explicit" and above any Sub. This makes Current available to all Subs in the module. You use Current.Range("C1") and Current.Range("C94") to refer to the cells. Or you can pass the value of C1 and C94 to Sub Mail_small_Text_Outlook(). You declare

[COLOR=#574123]Sub Mail_small_Text_Outlook(C1value as Integer, C94value as Integer)[/COLOR]

In strBody, use C1value and C94value instead of Range("C1").value and Range("C94").value.

You call the Sub like this:

Mail_small_Text_Outlook C1.value, C94.value

Or just try this:

[COLOR=#574123]For Each current In Worksheets[/COLOR]
[COLOR=#574123]If current.Range("C94").Value <> 0 Then
[/COLOR][COLOR=#ff0000]Current.Activate[/COLOR]
[COLOR=#574123]Mail_small_Text_Outlook[/COLOR]
[COLOR=#574123]MsgBox current.Name[/COLOR]
[COLOR=#574123]End If[/COLOR]

 

[Monaco]

YKY - for some reason your post does not show here, but I got it on my phone.

You fixed it! I added current.activate as you suggested and it does exactly what I need it to do.

Many thanks!

 

[yky]

Glad it works for you.

Something wrong with the message board software. Your last post is number 12 but the board thinks it it 11.

 

[Monaco]

Now I have good code that searches through each sheet in the workbook, but we have added some sheets where this sub is not necessary to have run there. How can I specify the specific sheets I want this to run in? They are named sheets.

Sub CheckBalances()
Dim ws As Worksheet
Dim lngRow As Long
Dim lngCount As Long
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 Variant

For Each current In Worksheets
MsgBox current.Name
If current.Range("C80").Value <> 0 Then
current.Activate
Mail_small_Text_Outlook
MsgBox current.Name
End If
Next
End Sub