Require Cell Entry before saving

[Whang56]

(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.

 

[jonhaus]

Give something like this a try.
Good Luck
-jonhaus
For more help with Excel and VBA visit my website

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

 

[jim may]

Am getting R/T error 9 - at line:

BlankFields(x) = "Sheets(""NB Form"").Range""" & NBFormReqRange(x) & """"

 

[jim may]

1

 

[Whang56]

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.

   [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.

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

[/QUOTE]