Excel VBA Before_Save code not generating desired outcome when user aborts message box prompt

Hi, everybody,

I have an Excel VBA Before Save procedure to check if the "as of" date listed in cell A2 on the front page of the Excel report has been updated (code listed below).  If the cell contains a date, and the date differs from the current date by more than 1 day, it prompts the user via message box to ask if the user wants to change the date first.  If the user selects yes, it takes them to the cell that contains the date, if they select no, it is intended to open the Save dialog box.

All of the above pieces work unless the user selects "No" to that message box.  In that case, the message box comes back up 2 additional times, and then the "User cancelled" message box comes up, though the Save File Dialog finally does appear after this.  I am not sure why this occurs, but I am looking to correct this, so that if the user selects "no" to the message box, only the File Save As dialog appears.

The macro is listed below:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Purpose:  Check before saving the file if the "as of" date is up to date
Dim ws As Worksheet

'Check cell A2 on worksheet "FrontPage_RevTeam"
Set ws = Sheets("FrontPage_RevTeam")
Dim DateCheck, CheckBeforeSave
'Check that cell A2 has a value in it, then check if that value is a date
DateCheck = ws.Range("A2").Value
If Not IsEmpty(DateCheck) Then
    If IsDate(DateCheck) Then
    'Check if the workbook has any changes made to it
        If ActiveWorkbook.Saved = False Then
            'Check if the value in A2 is older than today
            If DateDiff("d", DateCheck, Date) > 1 Then
                'Trigger a message box to the user to ask if they wanted to update the date
                CheckBeforeSave = MsgBox("Did you want to update the date?", vbYesNo + vbQuestion, "DateCheck")
                    'If yes, then set the cursor into FrontPageRev_Team!A2
                    If CheckBeforeSave = vbYes Then
                        ws.Range("A2").Activate
                    Else
                    'If no, trigger the File Save As dialog box
                        Dim bFileSaveAs As Boolean
                        bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
                        If Not bFileSaveAs Then MsgBox "User cancelled", vbCritical
                    End If
            End If
        End If
    End If
End If

End Sub

Open in new window


Thanks for any help you can provide,

doctornick0
LVL 1
doctornick0Regional Director of RevenueAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
I added lines 24 and 27.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Purpose:  Check before saving the file if the "as of" date is up to date
Dim ws As Worksheet

'Check cell A2 on worksheet "FrontPage_RevTeam"
Set ws = Sheets("FrontPage_RevTeam")
Dim DateCheck, CheckBeforeSave
'Check that cell A2 has a value in it, then check if that value is a date
DateCheck = ws.Range("A2").Value
If Not IsEmpty(DateCheck) Then
    If IsDate(DateCheck) Then
    'Check if the workbook has any changes made to it
        If ActiveWorkbook.Saved = False Then
            'Check if the value in A2 is older than today
            If DateDiff("d", DateCheck, Date) > 1 Then
                'Trigger a message box to the user to ask if they wanted to update the date
                CheckBeforeSave = MsgBox("Did you want to update the date?", vbYesNo + vbQuestion, "DateCheck")
                    'If yes, then set the cursor into FrontPageRev_Team!A2
                    If CheckBeforeSave = vbYes Then
                        ws.Range("A2").Activate
                    Else
                    'If no, trigger the File Save As dialog box
                        Dim bFileSaveAs As Boolean
                        Application.EnableEvents = False
                        bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
                        If Not bFileSaveAs Then MsgBox "User cancelled", vbCritical
                        Application.EnableEvents = True
                    End If
            End If
        End If
    End If
End If

Open in new window

0
byundtMechanical EngineerCommented:
When I tested the suggested code, it saved the file even if I said not to. The cure, I believe is to set Cancel to True in such circumstances.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Purpose:  Check before saving the file if the "as of" date is up to date
Dim ws As Worksheet

'Check cell A2 on worksheet "FrontPage_RevTeam"
Set ws = Sheets("FrontPage_RevTeam")
Dim DateCheck, CheckBeforeSave
'Check that cell A2 has a value in it, then check if that value is a date
DateCheck = ws.Range("A2").Value
If Not IsEmpty(DateCheck) Then
    If IsDate(DateCheck) Then
    'Check if the workbook has any changes made to it
        If ActiveWorkbook.Saved = False Then
            'Check if the value in A2 is older than today
            If DateDiff("d", DateCheck, Date) > 1 Then
                'Trigger a message box to the user to ask if they wanted to update the date
                CheckBeforeSave = MsgBox("Did you want to update the date?", vbYesNo + vbQuestion, "DateCheck")
                    'If yes, then set the cursor into FrontPageRev_Team!A2
                    If CheckBeforeSave = vbYes Then
                        ws.Range("A2").Activate
                    Else
                    'If no, trigger the File Save As dialog box
                        Dim bFileSaveAs As Boolean
                        Application.EnableEvents = False
                        bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show
                        If Not bFileSaveAs Then
                            MsgBox "User cancelled", vbCritical
                            Cancel = True
                        End If
                        Application.EnableEvents = True
                    End If
            End If
        End If
    End If
End If
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
byundtMechanical EngineerCommented:
I also noticed that the SaveAs dialog defaults to one of those #%*!! "copy of" style names. The cure for that is to pass the path and filename to the Dialog.Show method.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Purpose:  Check before saving the file if the "as of" date is up to date
Dim ws As Worksheet

'Check cell A2 on worksheet "FrontPage_RevTeam"
Set ws = Sheets("FrontPage_RevTeam")
Dim DateCheck, CheckBeforeSave
'Check that cell A2 has a value in it, then check if that value is a date
DateCheck = ws.Range("A2").Value
If Not IsEmpty(DateCheck) Then
    If IsDate(DateCheck) Then
    'Check if the workbook has any changes made to it
        If ActiveWorkbook.Saved = False Then
            'Check if the value in A2 is older than today
            If DateDiff("d", DateCheck, Date) > 1 Then
                'Trigger a message box to the user to ask if they wanted to update the date
                CheckBeforeSave = MsgBox("Did you want to update the date?", vbYesNo + vbQuestion, "DateCheck")
                    'If yes, then set the cursor into FrontPageRev_Team!A2
                    If CheckBeforeSave = vbYes Then
                        ws.Range("A2").Activate
                    Else
                    'If no, trigger the File Save As dialog box
                        Dim bFileSaveAs As Boolean
                        Application.EnableEvents = False
                        bFileSaveAs = Application.Dialogs(xlDialogSaveAs).Show(ThisWorkbook.FullName)
                        If Not bFileSaveAs Then
                            MsgBox "User cancelled", vbCritical
                            Cancel = True
                        End If
                        Application.EnableEvents = True
                    End If
            End If
        End If
    End If
End If
End Sub

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VBA

From novice to tech pro — start learning today.