Require Cell Entry before saving

Whang56

New Member
Joined
Feb 2, 2012
Messages
42
(Excel 2007) I have a workbook with several sheets with cells that require user input. Some fields are not that important, but others are very critical. All the critical fields say 'Required', but I still get people returning the workbook with no entry in these fields. I need a before-save macro to prevent saving the file before the critical fields are filled out.
To complicqate things, these fields are in several places in the workbook. For example, on the first sheet, labeled 'NB Form', the critical cells are C3,C4, I3,G7, G8, H12 & H22. On the second tab, labeled 'EQ PR', the critical cells are H5,K9,I12, D19.
All in all, I have 7 worksheets in this workbook that all have some critical fields. So I need the before-save macro to pop up a MsgBox that will identify which fields on which worksheets need entry before the workbook can be saved.

Thanks in advance for the help.
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Give something like this a try.
Good Luck
-jonhaus
For more help with Excel and VBA visit my website

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim NBFormReqRange()
Dim EQPRReqRange()
Dim BlankFields()
Dim y As Integer
NBFormReqRange = Array("C3", "C4", "I3", "G7", "G8", "H12", "H22")
EQPRReqRange = Array("H5", "K9", "I12", "D19")
 
For x = LBound(NBFormReqRange) To UBound(NBFormReqRange)
   
    If Sheets("NB Form").Range(NBFormReqRange(x)) = "" Then
        ReDim Preserve BlankFields(0 To y)
        BlankFields(x) = "Sheets(""NB Form"").Range""" & NBFormReqRange(x) & """"
        y = y + 1
    End If
 
Next x
 
For x = LBound(EQPRReqRange) To UBound(EQPRReqRange)
   
    If Sheets("EQ PR").Range(EQPRReqRange(x)) = "" Then
        ReDim Preserve BlankFields(0 To y)
        BlankFields(y) = "Sheets(""EQ PR"").Range""" & EQPRReqRange(x) & """"
        y = y + 1
    End If
 
Next x
 
If Join(BlankFields) <> "" Then
 
    MsgBox "Workbook Cannot be saved entry required in the  following ranges:" & vbCrLf & (Join(BlankFields, vbCrLf))
   
    Cancel = True
   
End If
   
End Sub
 
Upvote 0
Am getting R/T error 9 - at line:

BlankFields(x) = "Sheets(""NB Form"").Range""" & NBFormReqRange(x) & """"
 
Upvote 0
I put the code into ThisWorkbook and the following lines came up in red.

Editing the line brings a compile error. The word "Then" is highlighted and the error message is Expected: end of statement.


Code:
   [COLOR=#ff0000] If Sheets("NB Form").Range(NBFormReqRange(x)) = "" Then
        ReDim Preserve BlankFields(0 To y)[/COLOR]
        BlankFields(x) = "Sheets(""NB Form"").Range""" & NBFormReqRange(x) & """"
        y = y + 1
[COLOR=#ff0000]    End If[/COLOR]
 
Next x
 
For x = LBound(EQPRReqRange) To UBound(EQPRReqRange)
   
   [COLOR=#ff0000] If Sheets("EQ PR").Range(EQPRReqRange(x)) = "" Then
        ReDim Preserve BlankFields(0 To y)[/COLOR]
        BlankFields(y) = "Sheets(""EQ PR"").Range""" & EQPRReqRange(x) & """"
        y = y + 1
 [COLOR=#ff0000]   End If
 [/COLOR]


Then when I attermpted to save the form, I got a "Compile error: sub or function not defined", and the very first line "Private sub..." was highlighted yellow.

Code:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
[/QUOTE]
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top