- Dec 3, 2018
- Office Version
In the original post you didn't mention that they could be different cells for each sheet.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.
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