Excel crashing on close when two copies of file are open

efinn

New Member
Joined
Aug 11, 2011
Messages
3
I have an excel file that I've enabled users to download, the sheet contains code to enforce the use of macros. But since the users can download the file it appears they are leaving copies open and downloading new versions (since the data is constantly updated).

I believe the VBA in the file is causing issues with the copies of itself as when I attempt to close one (While I have two open) Excel will crash.

I looked through the code and made sure to reference ThisWorkbook wherever possible, but I don't have much experience with VBA.

The below code is all the VBA in the file, and is all located in the 'ThisWorkbook'

Any help locating the reason for the crash is much appreciated.

Code:
Option Explicit

Const WelcomePage = "Alert"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim answer As VbMsgBoxResult
    If Application.Calculation = xlCalculationAutomatic Then
        If ThisWorkbook.Saved = False Then
            Application.Calculation = xlCalculationManual
            answer = MsgBox("Do you want to save the changes you made to " & ThisWorkbook.Name & "?", vbYesNoCancel)
            If answer = vbYes Then
                Call HideAllSheets
                ThisWorkbook.Close True
            ElseIf answer = vbNo Then
                ThisWorkbook.Close False
            ElseIf answer = vbCancel Then
                Application.Calculation = xlCalculationAutomatic
                Cancel = True
            End If
        End If
    End If
End Sub

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

If Application.Calculation = xlCalculationAutomatic Then
    Dim ws As Worksheet
    Dim wsActive As Worksheet
    Dim vFilename As Variant
    Dim bSaved As Boolean

    'Turn off screen flashing
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    'Record active worksheet
    Set wsActive = ThisWorkbook.ActiveSheet
On Error GoTo Reset
    'Save workbook directly or prompt for saveas filename
    If SaveAsUI = True Then
        vFilename = Application.GetSaveAsFilename( _
                    fileFilter:="Excel Macro-Enabled Workbook(*.xlsm), *.xlsm")
        If CStr(vFilename) = "False" Then
            bSaved = False
        Else
            'Save the workbook using the supplied filename
            Call HideAllSheets
            ThisWorkbook.SaveAs vFilename
            Application.RecentFiles.Add vFilename
            Call ShowAllSheets
            bSaved = True
        End If
    Else
        'Save the workbook
        Call HideAllSheets
        ThisWorkbook.Save
        Call ShowAllSheets
        bSaved = True
    End If

    'Restore file to where user was
    wsActive.Activate
Reset:
    'Restore screen updates
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
On Error GoTo 0
   
    'Set application states appropriately
    If bSaved Then
        ThisWorkbook.Saved = True
        Cancel = True
    Else
        Cancel = True
    End If
End If

End Sub

Private Sub Workbook_Open()

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False
    Call ShowAllSheets
    Application.ScreenUpdating = True
    ThisWorkbook.Saved = True

    Dim w As Worksheet, p As PivotTable
    For Each w In ThisWorkbook.Worksheets
      For Each p In w.PivotTables
        p.RefreshTable
        p.Update
      Next
    Next


End Sub

Private Sub HideAllSheets()

    Dim ws As Worksheet

    ThisWorkbook.Worksheets(WelcomePage).Visible = xlSheetVisible

    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
    Next ws

    ThisWorkbook.Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
    Next ws

    ThisWorkbook.Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
After trying over a dozen different things I still can't find a reason why this behavior is happening. I think it has something to do with the code in 'Workbook_BeforeClose' but can't figure out what it is.

All the functions are private, so even being the 'same' file I can't see the code being accessed from one file to another. I also can't see anywhere in the code where a Excel level setting has been changed.

I tried opening two completely different files with the same VBA code and did not get a crash.
 
Upvote 0
I guess this was a bit technical for the forums, anyways I did manage to solve my own problem, hopefully this can help someone else.

I was able to find out this issue was related to 'ThisWorkbook.Close False' when several copies of the same file where open at once.

I was able to fix it by using the following code for before close.

Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim answer As VbMsgBoxResult
    If Application.Calculation = xlCalculationAutomatic Then
        If ThisWorkbook.Saved = False Then
            Application.Calculation = xlCalculationManual
            answer = MsgBox("Do you want to save the changes you made to " & ThisWorkbook.Name & "?", vbYesNoCancel)
            If answer = vbYes Then
                Call HideAllSheets
                ThisWorkbook.Close SaveChanges:=True
            ElseIf answer = vbNo Then
                Application.Calculation = xlCalculationAutomatic
                ThisWorkbook.Saved = True
            ElseIf answer = vbCancel Then
                Application.Calculation = xlCalculationAutomatic
                Cancel = True
            End If
        End If
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,592
Messages
6,179,789
Members
452,942
Latest member
VijayNewtoExcel

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