CODEWITHSUNDEEP
excelvba
Joanna Schweiger
Joanna Schweiger

Reputation: 147

Before_save event excel vb

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

Upvotes: 0

Views: 475

Answers (3)

FaneDuru
FaneDuru

Reputation: 42256

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...

Upvotes: 1

VBasic2008
VBasic2008

Reputation: 55073

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

Upvotes: 0

Toni
Toni

Reputation: 1585

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.

VBA

Upvotes: 1

Related Questions