mutliple "beforesave" functions in same workbook

**billkelley** · 10-20-2008, 12:37 PM

..again, thanks to this forum...great people....

I have my VB code working great - spreadsheet now requires data entry in a specific cell and that requirement has been delayed until a certain date with a IF THEN statement. Thanks to all that helped!!

I am now trying to broaden the "beforesave" requirement to multiple cells in the same workbook/worksheet. In the below VB statement, I don't know where to insert this additional command to require that a second cell have data entered into it before saving. The cell on the "Request for PTM" worksheet is H12.

I would need a second message to appear relating to that specific cell as well; similiar to first message "Current Installed Irr. System Entry Required"


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Date < #11/2/2008# Then Exit Sub
If IsEmpty(Sheets("Request for PTM").Range("H11").Value) Then
Sheets("Request for PTM").Activate
Range("H11").Select
MsgBox "Estimated Order Date Required"
Cancel = True
  End If
End Sub

Thanks for all the great help!! You guys are awesome!!!

**SimonK** · 10-20-2008, 03:20 PM

Hi billkelley

If you are going to do the same thing twice in vba, it is worth trying to write a separate function for it that can be used both times. Here is my attempt:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Date < #12/2/2008# Then Exit Sub
With Sheets("Request for PTM")
' test if the first cell is empty here:
    Cancel = StillEmpty(.Range("H11"), "Estimated Order Date Required")
    'If cancelled, exit sub otherwise the user may get 2 irritating error messages together
    If Cancel Then Exit Sub
' now test if the second cell is empty:
    Cancel = StillEmpty(.Range("H12"), "Current Installed Irr. system entry required")
End With
End Sub

Private Function StillEmpty(r As Range, FailMsg As String) As Boolean
'Description    : if r is empty, FailMsg is displayed and function returns true
'               : otherwise, function returns false

If IsEmpty(r.Value) Then
    StillEmpty = True       'if cell is empty, return true
    r.Worksheet.Activate    'select r's worksheet
    r.Select                'select empty cell
    MsgBox FailMsg, , "Oops!"
End If

End Function

As the function StillEmpty returns true or false, you can assign it straight to the Cancel variable.

**MatrixMan** · 10-20-2008, 03:21 PM

Here's code for doing them individually (simple extension of your code, but means that each condition is check in sequence so code exits when it is met and the second condition - if appliable - would only be met on the second attempt to save):

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'this will check both cells but only display a message for the first one
    'encountered when the event is triggered; the second one is triggered if
    'not completed and a save is attempted again:
    If Date < #11/2/2008# Then
        Exit Sub
    ElseIf IsEmpty(Sheets("Request for PTM").Range("H11").Value) Then
        Sheets("Request for PTM").Activate
        Range("H11").Select
        MsgBox "Estimated Order Date Required"
        Cancel = True
    ElseIf IsEmpty(Sheets("Request for PTM").Range("H12").Value) Then
        Sheets("Request for PTM").Activate
        Range("H12").Select
        MsgBox "Current Installed Irr. System Entry Required"
        Cancel = True
    Else
        'nothing
    End If
End Sub

And here's code for both at the same time:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    'this will check both cells at the same time but you can only set one cell
    'to point the user to; you could set them both to (say) red and then undo
    'that when successfully saved:
    Sheets("Request for PTM").Range("H11:H12").Interior.Color = 16777215
    If Date < #11/2/2008# Then
        Exit Sub
    ElseIf IsEmpty(Sheets("Request for PTM").Range("H11").Value) And IsEmpty(Sheets("Request for PTM").Range("H12").Value) Then
        Sheets("Request for PTM").Activate
        Range("H11").Select
        Range("H11:H12").Interior.Color = vbRed
        MsgBox "Estimated Order Date & Current Installed Irr. System Required"
        Cancel = True
    ElseIf IsEmpty(Sheets("Request for PTM").Range("H11").Value) Then
        Sheets("Request for PTM").Activate
        Range("H11").Select
        Range("H11").Interior.Color = vbRed
        MsgBox "Estimated Order Date Required"
        Cancel = True
    ElseIf IsEmpty(Sheets("Request for PTM").Range("H12").Value) Then
        Sheets("Request for PTM").Activate
        Range("H12").Select
        Range("H12").Interior.Color = vbRed
        MsgBox "Estimated Order Date Required"
        Cancel = True
    Else
        'nothing (or other checks etc):
    End If
End Sub

There is a lot of literature out there about validating data entry and while this sort of check is a good idea you need to be careful about over-using it because it means a user physically can't save the workbook in draft without meeting all your conditions (and if there are lots, then this can be annoying). Hope that helps. MM.