VBA Close Code not closing properly

FrancisM · #1 (**permalink**) June 14th, 2019, 08:54 AM

I am trying to close an application when the user clicks either the Red X, a button. Previously I used code below to close the application, when the button was clicked. It worked as expected. Here is the code:

Code:

Sub Exit_Referrals()
Dim MsgBoxResult As Long

 MsgBoxResult = MsgBox("Would you like to Exit the Referral Workbook?" & vbCr, _
 vbYesNo, "Voc. Rehab. - Referral")
 If MsgBoxResult = vbNo Then
 Exit Sub
 ElseIf MsgBoxResult = vbYes Then
 Sheets("TOC").Select
 Application.Calculation = xlCalculationAutomatic
Application.Quit
ThisWorkbook.Close SaveChanges:=True
 End If
End Sub

When i tried to activate the code, when the Red X, was clicked, I ran into some problems. 1) You are asked if you want to exit the application 2x; 2) The application closes, but Excel remains open; 3) if you choose No (remain open),the application closes. I have the same problem when the button is clicked. Here is the current code:
This is located on thisworkbook

Code:

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
      'Exits application
       Call Exit_Referrals
End Sub

The Sub Exit_Referrals() is located in module 1. I know I am missing something, but it escapes me.

FrancisM · #2 (**permalink**) June 14th, 2019, 03:13 PM

I could not believe how simple the solution was. I even added a msgbox. Here is the first code & placed in THEWORKBOOK:

Code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    If CloseMode = vbFormControlMenu Then
    Cancel = True
    MsgBox "Click on Exit button to close!"
    Application.EnableEvents = False
End If
    
End Sub

The second code is in the module 1.

Code:

Sub Exit_Referrals()
Dim MsgBoxResult As Long
  MsgBoxResult = MsgBox("Would you like to Exit the Referral Workbook?" & vbCr, _
   vbYesNo, "Vocational Services Database - " & ActiveSheet.Name)
   If MsgBoxResult = vbNo Then
    Exit Sub
 ElseIf MsgBoxResult = vbYes Then
   Sheets("TOC").Select
    Application.Calculation = xlCalculationAutomatic
      If ThisWorkbook.Saved = False Then
            ThisWorkbook.Save
            End If
             ThisWorkbook.Close SaveChanges:=True
  Application.Quit
 End If
 
End Sub

Need to download code?

Navigation