Expanding a working code in Workbook_BeforeSave to more sheets with small alterations? VBA

[JBM91]

Hi experts!

I'm fairly new to VBA to say the least, but I have managed to piece together a code that works and does exactly what I want it to. The code looks as follows:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)



Dim Rng1 As Range
Dim Rng2 As Range
Dim Prompt As String
Dim Cell As Range
Dim AllowSave As Boolean

AllowClose = True
Set Rng1 = Sheets("example").Range("A6, M6, Y6, A9, M9, Y9, AF9, A12")
Prompt = "Please check your data ensuring all required " & _
"cells are complete." & vbCrLf & "You will not be able " & _
"to close or save the workbook until the form has been filled " & _
"out completely. " & vbCrLf & vbCrLf & _
"The following cells are incomplete:" & vbCrLf & vbCrLf

For Each Cell In Rng1
If Application.Sheets("example").Range("C42").Value <> "" And Cell.Value = vbNullString Or Cell.Value = "0" Then
Prompt = Prompt & Cell.Address(False, False) & vbCrLf
AllowClose = False
If Rng2 Is Nothing Then
Set Rng2 = Cell
Else
Set Rng2 = Union(Rng2, Cell)
End If
End If
Next

If AllowClose Then
Else
MsgBox Prompt, vbCritical, "Data entry missing"
Cancel = True
Rng2.Select
End If


End Sub


The thing is, as per defined in the code, this will only apply to the specific sheet "example1". What I essentially would like, is to also have the "same code", with varying alterations to the:

Set Rng1 = Sheets("Dekanter").Range("A6, M6, Y6, A9, M9, Y9, AF9, A12")

and

If Application.Sheets("Dekanter").Range("C42").Value <> "" And Cell.Value = vbNullString Or Cell.Value = "0"


.. applied to- and working on other sheets, say "example2", "example3" etc., with each sheet only being governed by its own code and independent from the other - if that makes sense(?)

(As of right now, this code is placed in "ThisWorkbook")

However, I'm not at all sure on how to do so, and as such, any help or tips from the heavies would be greatly appreciated!

Best regards,

Jannick

 

[DanteAmor]

Hi @JBM91, welcome to the forum!


I made some changes to the code.
I removed the part of selecting the cells because they can be different sheets.



Try this

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  Dim Rng1 As Range, Prompt As String, Cell As Range, AllowClose As Boolean, sh As Worksheet
  '
  AllowClose = True
  Prompt = "Please check your data ensuring all required cells are complete." & vbCr & _
    "You will not be able to close or save the workbook until the form has been filled out " & _
    "completely." & vbCr & vbCr & "The following cells are incomplete:" & vbCr & vbCr
  '
  For Each sh In Sheets
    Select Case sh.Name
      Case "example1", "example2", "example3" 'Put here the names of the sheets to verify
        Set Rng1 = sh.Range("A6, M6, Y6, A9, M9, Y9, AF9, A12")
        For Each Cell In Rng1
          If sh.Range("C42").Value <> "" And Cell.Value = vbNullString Or Cell.Value = "0" Then
            Prompt = Prompt & Cell.Worksheet.Name & "-" & Cell.Address(False, False) & vbCr
            AllowClose = False
          End If
        Next
        Prompt = Prompt & vbCr
    End Select
  Next
  If AllowClose = False Then
    MsgBox Prompt, vbCritical, "Data entry missing"
    Cancel = True
  End If
End Sub

 

[dmt32]

Hi,
If the ranges are the same for each sheet & the sheet is active when you perform the save or close action then you could just change this line

Set Rng1 = Sheets("Dekanter").Range("A6, M6, Y6, A9, M9, Y9, AF9, A12")

to this

Set Rng1 = ActiveSheet.Range("A6, M6, Y6, A9, M9, Y9, AF9, A12")

Dave

 

[JBM91]

Hi Dante,

Thanks for the swift reply!

The thing about the solution you posted is that Rng1 will then be the same for all sheets the code is applied to - "A6, M6, Y6, A9, M9, Y9, AF9, A12", respectively, which is unfortunately not the case - the same goes for the "If sh.Range("C42").Value <> "" And Cell.Value = vbNullString Or Cell.Value = "0" Then".

On sheet2 the rng1 might be A3, M3, Y3 and the sh.range for value reference might be C40.
On sheet3 it might be Z1, O1, U1, and the sh.range for value reference might be T50
.. and so on.

So I guess what I'm looking for is a way to take the layout and structure of the code, and then apply it with appropriate and specific alterations for each sheet in my workbook.
I'm just not sure how to take the code from its current location in "ThisWorkbook" and then apply it to each individual sheet with appropriate changes.

Best regards,

Jannick

 

[JBM91]

Hi Dave,

Thanks for the quick reply!

I'm afraid that's not the case - On sheet2 the rng1 might be A3, M3, Y3 and the sh.range for value reference might be C40. On sheet3 it might be Z1, O1, U1, and the sh.range for value reference might be T50
.. and so on.

So I guess what I'm looking for is a way to take the layout and structure of the code, and then apply it with appropriate and specific alterations for each sheet in my workbook.
I'm just not sure how to take the code from its current location in "ThisWorkbook" and then apply it to each individual sheet with appropriate changes.

Best regards,

Jannick

 

[dmt32]

No worries,
are you just wanting to check the active sheet for range completion before saving / closing? Or do you want to check ALL sheets in a list and their specified ranges?

Dave

 

[JBM91]

Preferably the latter, so that all sheets need to fulfill their respective criteria before the book can be closed.

//Jannick

 

[dmt32]

Preferably the latter, so that all sheets need to fulfill their respective criteria before the book can be closed.

//Jannick

probably the solution maybe to change your sub to a Function


Place following update to your code in a STANDARD module

Function DoNotAllow() As Boolean
    Dim Rng1 As Range, ReferenceCell As Range
    Dim Rng2 As Range, Cell As Range
    Dim i As Integer
    Dim Prompt As String
    Dim ws As Worksheet
    
    
    For Each ws In Worksheets(Array("Dekanter", "example"))
        i = i + 1
        
        Set Rng1 = ws.Range(Choose(i, "A6, M6, Y6, A9, M9, Y9, AF9, A12", _
                                      "A3, Y3, M3"))
        
        Set ReferenceCell = ws.Range(Choose(i, "C42", "C40"))


        Prompt = "Please check your data ensuring all required " & _
        "cells are complete." & vbCrLf & "You will not be able " & _
        "to close or save the workbook until the form has been filled " & _
        "out completely. " & vbCrLf & vbCrLf & _
        "The following cells are incomplete:" & vbCrLf & vbCrLf
        
        For Each Cell In Rng1
            If Len(ReferenceCell.Value) > 0 And Cell.Value = vbNullString Or Cell.Value = "0" Then
                Prompt = Prompt & Cell.Address(False, False) & vbCrLf
                If Rng2 Is Nothing Then
                    Set Rng2 = Cell
                Else
                    Set Rng2 = Union(Rng2, Cell)
                End If
            End If
        Next
        
        DoNotAllow = CBool(Not Rng2 Is Nothing)
        
        If DoNotAllow Then
            ws.Activate
            Rng2.Select
            MsgBox ws.Name & Chr(10) & Prompt, vbCritical, "Data entry missing"
            Exit Function
        End If
        
        Set Rng1 = Nothing
        Set Rng2 = Nothing
        Set ReferenceCell = Nothing
        Prompt = ""
    Next ws
End Function

Notes: 1 - Enter the ranges for Rng1 as shown in example shown in BLUE
2 - Enter the ranges for ReferenceCell Shown in ORANGE
3 - Enter the worksheet names Shown in RED

add following code to the THISWORKBOOK code page

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Cancel = DoNotAllow
End Sub




Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = DoNotAllow
End Sub

Not fully tested but hopefully will do what you want


Dave

 

[JBM91]

probably the solution maybe to change your sub to a Function


Place following update to your code in a STANDARD module

Function DoNotAllow() As Boolean
    Dim Rng1 As Range, ReferenceCell As Range
    Dim Rng2 As Range, Cell As Range
    Dim i As Integer
    Dim Prompt As String
    Dim ws As Worksheet
    
    
    For Each ws In Worksheets(Array("Dekanter", "example"))
        i = i + 1
        
        Set Rng1 = ws.Range(Choose(i, "A6, M6, Y6, A9, M9, Y9, AF9, A12", _
                                      "A3, Y3, M3"))
        
        Set ReferenceCell = ws.Range(Choose(i, "C42", "C40"))


        Prompt = "Please check your data ensuring all required " & _
        "cells are complete." & vbCrLf & "You will not be able " & _
        "to close or save the workbook until the form has been filled " & _
        "out completely. " & vbCrLf & vbCrLf & _
        "The following cells are incomplete:" & vbCrLf & vbCrLf
        
        For Each Cell In Rng1
            If Len(ReferenceCell.Value) > 0 And Cell.Value = vbNullString Or Cell.Value = "0" Then
                Prompt = Prompt & Cell.Address(False, False) & vbCrLf
                If Rng2 Is Nothing Then
                    Set Rng2 = Cell
                Else
                    Set Rng2 = Union(Rng2, Cell)
                End If
            End If
        Next
        
        DoNotAllow = CBool(Not Rng2 Is Nothing)
        
        If DoNotAllow Then
            ws.Activate
            Rng2.Select
            MsgBox ws.Name & Chr(10) & Prompt, vbCritical, "Data entry missing"
            Exit Function
        End If
        
        Set Rng1 = Nothing
        Set Rng2 = Nothing
        Set ReferenceCell = Nothing
        Prompt = ""
    Next ws
End Function

Notes: 1 - Enter the ranges for Rng1 as shown in example shown in BLUE
2 - Enter the ranges for ReferenceCell Shown in ORANGE
3 - Enter the worksheet names Shown in RED

add following code to the THISWORKBOOK code page

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Cancel = DoNotAllow
End Sub




Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Cancel = DoNotAllow
End Sub

Not fully tested but hopefully will do what you want


Dave

"Thank you'ed", liked and upvoted.

That's exactly what I needed! I did a few tests and as far as I can tell it's working absolutely flawless.

Thank you so much for your help, much appreciated!

//Jannick

 

[dmt32]

"Thank you'ed", liked and upvoted.

That's exactly what I needed! I did a few tests and as far as I can tell it's working absolutely flawless.

Thank you so much for your help, much appreciated!

//Jannick

Glad solution helps you

many thanks for your kind feedback


Dave