Alex,

Yes, that was a first impression and it wasn't good advice.
I've gone back thru the code and have rewritten it some.
I had to comment out the Hide and Show AllSheets portion
as I don't have that code.
I tried this a couple of time and it seems to work.
Note the module level variable and the error handling that
was added.

Jim Cone


'--------------------------------
Option Explicit

Private blnContinue As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo Err_Handler
If blnContinue Then Exit Sub
'Evaluate if workbook is saved and emulate default prompts
If Not ThisWorkbook.Saved Then
Select Case MsgBox("Do you want to save the changes you made to " _
& ThisWorkbook.Name & "'?", vbYesNoCancel + vbExclamation)
Case vbYes
'Call customized save routine
If ActiveWorkbook.ReadOnly Then
MsgBox ("The Application is read-only. You cannot save changes.")
Else
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
Call CustomSave
Application.EnableEvents = True
End If
Case vbNo
'Do not save
blnContinue = True
ThisWorkbook.Close savechanges:=False
Case vbCancel
Cancel = True
End Select
End If
Exit Sub
Err_Handler:
Application.EnableEvents = True
End Sub
'-----------
Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False
'Record active worksheet
Set aWs = ActiveSheet
'****************
' If ActiveSheet.Name < "Sheet1" Then Call HideAllSheets
'****************
'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If
'****************
'Restore file to where user was
' Call ShowAllSheets
'****************
aWs.Activate
'Restore screen updates
Application.ScreenUpdating = True
End Sub
'----------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo Err_Handler
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
Exit Sub
Err_Handler:
Application.EnableEvents = True
End Sub
'-------------------------------------------------


"Alex"

wrote in message
...
Thanks again, Jim.
But, with the changes from Not Cancel = True to Cancel = True it's asking to
save it without stopping (some loop).