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

In the original post you didn't mention that they could be different cells for each sheet.


But no problem, I attached the updated code, with another approach, in the end the result shows you the sheets and cells without data.

I also marked the place where you can put your data.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, cancel As Boolean)
  Dim Rng1 As Range, rng2 As Range, Prompt As String, Cell As Range, AllowClose As Boolean, sh As Worksheet
  Dim shs As Variant, rgs As Variant, cls As Variant, h As Long
  '
  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
  '
[COLOR=#0000ff]  shs = Array("example1", "example2", "example3")  'sheets[/COLOR]
  [COLOR=#008000]rgs = Array("A6, M6, Y6, A9, M9, Y9, AF9, A12", "Z1, O1, U1", "D3, D5, D6") 'ranges[/COLOR]
[COLOR=#b22222]  cls = Array("C40", "C41", "C42") 'cells[/COLOR]


  For h = 0 To UBound(shs)
    Set sh = Sheets(shs(h))
    Set Rng1 = sh.Range(rgs(h))
    For Each Cell In Rng1
      If sh.Range(cls(h)).Value <> "" And Cell.Value = vbNullString Or Cell.Value = "0" Then
        Prompt = Prompt & Cell.Worksheet.Name & "-" & Cell.Address(False, False) & vbCr
        AllowClose = False
        If rng2 Is Nothing Then
          Set rng2 = Cell
        Else
          Set rng2 = Union(rng2, Cell)
        End If
      End If
    Next
    Prompt = Prompt & vbCr
    If AllowClose = False Then
      sh.Select
      rng2.Select
      MsgBox Prompt, vbCritical, "Data entry missing"
      Set rng2 = Nothing
      cancel = True
    End If
  Next
End Sub