Before_save event excel vb - excel

Question

Excel VB newbie. I know I must be missing something very simple. How do I get before_save event to work with more than one worksheet? Only one needs code. I have it in ThisWorkbook. It works if I only have one sheet in my workbook.
After seeing the comment that it doesn't matter if there's more than one worksheet I looked again at my code. I fixed the code and now the BeforeSave event will trigger and not save until all conditions are met like it's supposed to.
The BeforeSave event triggers if I put it in ThisWorkbook. But if I put it in Sheet1 and call the sub in ThisWorkbook, it still runs the sub like it's supposed to but doesn't prevent it from saving. Hoping this makes sense. I know the code is messy so please bear with me.
Sheet1:
Sub checkSheet1()
Dim cellCount As Variant, findEmpty As String, Counter%
allYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"), Range("C62"))
noDateYellowCellsArray = Array(Range("C6"), Range("C7"), Range("C8"), Range("C9"), Range("C18"), Range("C19"), Range("C20"), Range("C21"), Range("C22"), Range("C29"), Range("C30"), Range("C31"), Range("C32"), Range("C33"), Range("C42"))
emptyCell = ""
Counter = 0
Debug.Print vbNewLine & "List the values of each cell in the array:"
'count number of yellow/empty cells
For Each cellCount In allYellowCellsArray
Debug.Print cellCount.Address() & " value is " & cellCount & " and color is " & cellCount.DisplayFormat.Interior.Color
If cellCount = emptyCell Then
Counter = Counter + 1
End If
Next
'If-Then statements to alert how many yellow cells are still empty.
If Counter >= 1 Then
MsgBox "(" & Counter & ") Mandatory Cells Have Not Been Completed", vbExclamation, "Missing Information"
'cellCount = "Enter Missing Information"
End If
For Each cellCount In noDateYellowCellsArray
If cellCount.Value = "" Then
cellCount.Value = "Enter Missing Information"
End If
Next
'Evaluate all yellow cells to prevent empty cells and make sure the set values have been changed ----
Dim cellValue As Variant
Dim fieldsAreYellow As Boolean
fieldsAreYellow = True
Dim redCellColor As Boolean
redCellColor = True
Dim cellCellColor As Variant
Debug.Print vbNewLine & "List cells that are red:"
For Each cellCellColor In allYellowCellsArray 'check for red cells
If cellCellColor.DisplayFormat.Interior.Color = 255 Then 'if cell background color is red
redCellColor = True
Debug.Print cellCellColor.Address() & " is " & cellCellColor.DisplayFormat.Interior.Color
Cancel = True
End If
If redCellColor = False Then
MsgBox "There are no more red cells."
Cancel = True
End If
Next cellCellColor
Dim cellCountRedCells As Variant, redCellCounter%
redCellCounter = 0
For Each cellCountRedCells In allYellowCellsArray
If cellCountRedCells.DisplayFormat.Interior.Color = 255 Then 'red
redCellCounter = redCellCounter + 1
Debug.Print "redCellCounter is " & redCellCounter
'MsgBox "redCellCounter is " & redCellCounter
End If
Next
Debug.Print "redCellCounter is " & redCellCounter
'Check to see if cells in array have been changed
Debug.Print vbNewLine & "List the current background color of the first non-numeric cell that stopped the loop:"
For Each cellValue In allYellowCellsArray
If cellValue = "Enter Missing Information" Then
Debug.Print vbNewLine & cellValue
fieldsAreYellow = False
Debug.Print cellValue.Address() & " color is " & cellValue.DisplayFormat.Interior.Color
MsgBox "Check all of your cells for correct information." & vbNewLine & "There are still (" & redCellCounter & ") red cells.", vbCritical, "SAVE CANCELLED"
Cancel = True ' ** prevent the file from being saved **
Exit For
End If
Next cellValue
'Final check
If (fieldsAreYellow = True) And (redCellCounter = 0) Then
MsgBox "The document will be saved." & vbNewLine & "Remember the naming convention." & vbNewLine & "Customer_PIP Seal Calculator_Part Number rev#_Part Name_DDMMYY", vbInformation, "Good to Go!"
Cancel = False 'allow save
Else:
MsgBox "This file will not save until all of the cells have correct information.", vbCritical, "SAVE CANCELLED"
Cancel = True 'cancel save
End If
End Sub
ThisWorkbook:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call Sheet1.checkSheet1
End Sub

Answer 1

I created a new excel file and tested this event. It works perfectly on both sheets.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
MsgBox "OK"
End Sub
I suggest to try this on a new file and then copy your code to the new file.

Answer 2

In order to make the event was as you need, the called Sub must be transformed in a Function returning Boolean.
The event code should look like this:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = Sheet1.checkSheet1
End Sub
And the called function, like this:
Public Function checkSheet1() As Boolean
If 1 = 1 Then
MsgBox "The saving cannot take place..."
checkSheet1 = True 'instead of Cancel = True in the Sub
Else
checkSheet1 = False
End If
End Function
You must adapt your code to finally return something like checkSheet1 = Cancel. But take care to properly declare Dim Cancel as Boolean...
If something unclear, please, do not hesitate to ask for clarifications. If you need me to transform your existing Sub, I can do it, but I think it is better for you do do that, in order to understand the meaning and learn...

Answer 3

Loop Through Worksheets In BeforeSave
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
' Create a list of worksheet names.
Const wsList As String = "Sheet1,Sheet2,Sheet3"
Dim nms() As String ' Declare an array of type 'String'.
nms = Split(wsList, ",") ' Write the list to the array.
Dim ws As Worksheet ' Declare a worksheet variable.
Dim n As Long ' Declare a 'counter' variable of type 'Long'.
' Loop through the elements (names) in the array.
For n = 0 To UBound(nms)
' Define current worksheet.
Set ws = ThisWorkbook.Worksheets(nms(n))
' Do something, e.g. write some text to cell 'A1' and autofit column 'A'.
ws.Range("A1").Value = "Testing worksheet '" & ws.Name & "'."
ws.Columns("A").AutoFit
Next n
End Sub