This code has caused Microsoft excel to stop working when I click save as new
filename.

Mark

"john" wrote:

see if this does what you want?


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strPath As String
Dim strFilename As String
Dim userResponse As Variant

Application.EnableEvents = False

strFilename = "Kelso Resources WC " & _
Format(Sheets("KelsoResources").Range("N2"), "dd-mmm-yy")

userResponse = MsgBox("Do you want to save as " & _
strFilename, vbYesNo + vbInformation, _
"Kelso Operational Resources © MN ")

If userResponse = vbYes Then

strPath = "C:\Users\Mark\Desktop"

strFilename = strPath & "\" & strFilename & ".xls"

ThisWorkbook.SaveAs Filename:=strFilename, _
FileFormat:=xlNormal, _
CreateBackup:=False

Cancel = False

Else

Cancel = True

End If

Application.EnableEvents = True

End Sub

--
jb


"terilad" wrote:

Hi,

I need some more help with this code when msg box appears do you want to
save as etc I click yes thats fine it saves as the new filename, but when I
click No it is still saving changes in workbook to old filename, I need the
workbook to close without any changes made if No is selected in msg box, can
you help with this.

Here is the code:

End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim strPath As String
Dim strFilename As String
Dim userResponse As Variant
Application.EnableEvents = False
strFilename = "Kelso Resources WC " & Format(Sheets("Kelso
Resources").Range("N2"), "dd-mmm-yy")
userResponse = MsgBox("Do you want to save as " & strFilename, vbYesNo +
vbInformation, "Kelso Operational Resources © MN ")
If userResponse = vbYes Then
strPath = "C:\Users\Mark\Desktop"
strFilename = strPath & "\" & strFilename & ".xls"
ThisWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlNormal,
CreateBackup:=False
Cancel = False
End If
Application.EnableEvents = False
End Sub


Regards


Mark