BeforeClose/Before Save On Multiple Tabs

[marcwlms]

I had a spreadsheet which has the following vba query set upinthe This Workbook

Apart from the opening message and it openeing inthe 1st column. The VBA applies so that the 1st 14 fields in a row must be completed once data is entered into column A. as this spreadsheet has evolved ive been asked to split the data into separate tabs.

Ideally i would like to apply the same kind of rules around mandatory columns in this new second tab.

Option Explicit

Private Sub Workbook_Open()
Application.Goto Worksheets("Formal").Cells(Rows.Count, "A").End(xlUp).Offset(1)

MsgBox "**WARNING**""When initially logging a case entries are mandatory in columns A - O." & vbNewLine & vbNewLine & "If you try to close or save the spreadsheet without completing these cells" & vbNewLine & "you will receive a warning showing which cells you have not completed." & vbNewLine & vbNewLine & "If you attempt to continue saving or closing the spreadsheet without these mandatory cells completed, your changes will NOT be saved"

End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim rngCell As Range, strBlanks As String

Application.ScreenUpdating = False

strBlanks = vbNullString
For Each rngCell In Worksheets("Formal").Range("a2:a2000").Cells
If Len(Trim(rngCell.Value)) > 0 Then
If WorksheetFunction.CountA(rngCell.Offset(0, 1).Resize(1, 14)) < 14 Then
strBlanks = strBlanks & IIf(Len(strBlanks) > 0, ",", "") & _
Replace(rngCell.Offset(0, 1).Resize(1, 14).SpecialCells(xlCellTypeBlanks).Address, "$", "")
End If
End If
Next

If Not strBlanks = vbNullString Then
MsgBox "**WARNING**" & vbNewLine & vbNewLine & "When initially logging a case entries are mandatory in columns A - O." & vbNewLine & vbNewLine & "Please complete entries in the following cells" & vbCrLf & vbCrLf & strBlanks
Cancel = True
Exit Sub
End If
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim rngCell As Range, strBlanks As String

Application.ScreenUpdating = False

strBlanks = vbNullString
For Each rngCell In Worksheets("Formal").Range("a2:a2000").Cells
If Len(Trim(rngCell.Value)) > 0 Then
If WorksheetFunction.CountA(rngCell.Offset(0, 1).Resize(1, 14)) < 14 Then
strBlanks = strBlanks & IIf(Len(strBlanks) > 0, ",", "") & _
Replace(rngCell.Offset(0, 1).Resize(1, 14).SpecialCells(xlCellTypeBlanks).Address, "$", "")
End If
End If
Next

If Not strBlanks = vbNullString Then
MsgBox "**WARNING**" & vbNewLine & vbNewLine & "When initially logging a case entries are mandatory in columns A - O." & vbNewLine & vbNewLine & "Please complete entries in the following cells" & vbCrLf & vbCrLf & strBlanks
Cancel = True
Exit Sub
End If
End Sub



Is this possible?

Where would this VBA be pasted so it didnt interfere with the already established VBA?

Thanks in advance

Marc

 

[SirJB7]

Hi, marcwlms!

The posted procedures:
Private Sub Workbook_Open()
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
should be placed in the workbook class module (ThisWorkbook), so the can't be copied anywhere else, at least entirely.

If you want to expand the operations done on/with worksheet Formal to a 2nd worksheet, e.g. Casual, you should copy the required snippets into each procedure or embed them within an external embracing For...Next loop for cycling thru worksheets, like:

    For Each ws In Worksheets(Array("Formal", "Casual"))
        ...
    Next ws

And replacing the actual:
Worksheets("Formal")
by:
ws

Regards!