Excel VBA Creating/overwriting a new workbook and using the cancel button - vba

Question

I have a macro written that take a range from one workbook and copies into into a new workbook, which then saves the newly created workbook (and gives it a name) into the same folder path. When this workbook already exists, (overwriting the workbook), the default windows dialogue box pops up asking if you would like to overwrite, with a yes no cancel selection of buttons. When the cancel button is pressed, a new workbook is created. How do I edit this code so that when cancel is pressed, no new workbook is created? I have pasted the macro below:
Sub ExportNewBook()
Application.ScreenUpdating = False
Dim ThisWB As Workbook
Set ThisWB = ActiveWorkbook
Set NewBook = Workbooks.Add
On Error Resume Next
ThisWorkbook.Worksheets("Summary").Range("A1:I100").Copy
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)
NewBook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteFormats)
NewBook.Worksheets("Sheet1").Range("A:J").Columns.AutoFit
NewBook.SaveAs Filename:=ThisWB.Path & "\" & NewBook.Worksheets("Sheet1").Range("A4").Value & "_Summary"
NewBook.ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
EDIT: WORKING CODE SHOWN BELOW
Sub ExportNewBook()
Application.ScreenUpdating = False
Dim ThisWB As Workbook
Dim fname As String
Set ThisWB = ActiveWorkbook
Set Newbook = Workbooks.Add
ThisWorkbook.Worksheets("Summary").Range("A1:I100").Copy
Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)
Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteFormats)
Newbook.Worksheets("Sheet1").Range("A:J").Columns.AutoFit
fname = ThisWB.Path & "\" & ThisWB.Worksheets("Summary").Range("A4").Value & "_Summary.xls"
If Dir(fname) <> "" Then
If MsgBox("Summary output already exists, are you sure you want to overwrite?", vbOKCancel) = vbCancel Then Newbook.Close False: Application.CutCopyMode = False: Exit Sub
End If
Application.DisplayAlerts = False
Newbook.SaveAs Filename:=fname
Application.DisplayAlerts = True
ThisWB.Activate
ActiveWorkbook.Worksheets("Summary").Range("A1").Select
Newbook.Activate
ActiveWorkbook.ActiveSheet.Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
Thank you!

Answer 1

On error resume next is seldom a good idea. If the user selects no or cancel, an error is triggered. Better to handle that error to delete the unwanted workbook (although another idea is to test if a workbook with the target name exists before creating it and, if it does, use msgbox to ask the user if they want to overwrite the file and, if so, only then create the workbook, disable alerts, and only then do saveas).
A problem seems to be that you need to have a filename to kill a workbook. In your situation the workbook doesn't yet have a filename. One solution is to create a safe filename whose sole purpose in life is to kill an unwanted workbook, do saveas again with this name, then kill it. Something like this:
Sub Test()
On Error GoTo err_handler
Dim wb As Workbook
Dim fname As String
Dim tempname As String
fname = "C:\Programs\testbook.xlsx"
Set wb = Workbooks.Add
wb.Sheets(1).Range("A1").Value = Now 'for testing purposes
wb.SaveAs fname
Exit Sub
err_handler:
tempname = "C:\Programs\name_i_will_never_use.xlsx"
wb.SaveAs tempname
wb.Close
Kill tempname
End Sub

Answer 2

Here is a possible approach:
Sub ExportNewBook()
Application.ScreenUpdating = False
Dim ThisWB As Workbook, Newbook As Workbook
Dim fname As String
Set ThisWB = ActiveWorkbook
fname = ThisWB.Path & "\" & ThisWB.Sheets("Sheet1").Range("A4").Value & "_Summary"
If Dir(fname) <> "" Then
If MsgBox("Are you sure you want to overwrite?", vbOKCancel) = vbCancel Then Exit Sub
End If
Set Newbook = Workbooks.Add
ThisWB.Worksheets("Summary").Range("A1:I100").Copy
Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteValues)
Newbook.Worksheets("Sheet1").Range("A1").PasteSpecial (xlPasteFormats)
Newbook.Worksheets("Sheet1").Range("A:J").Columns.AutoFit
'This code should be faster since it bypasses the copy-paste buffer
'With Newbook.Sheets(1)
' ThisWB.Sheets("Summary").Range("A1:I100").Copy .Range("A1")
' .Range("A1:I100").Value = .Range("A1:I100").Value
' .Columns.AutoFit
'End With
Application.DisplayAlerts = False
Newbook.SaveAs Filename:=fname
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Answer 3

this is the full code with
check if file already exist
if exist close the newbook and ask you if the existed file will be opened
close the newbook
in case of error save the newbook with (error) suffix before the extension file
Sub ExportNewBook()
Application.ScreenUpdating = False
Dim ThisWB As Workbook
Dim NewName As String
Set ThisWB = ActiveWorkbook
Set NewBook = Workbooks.Add
On Error GoTo err_handler
ThisWB.Worksheets("Summary").Range("A1:I100").Copy
NewBook.Worksheets("Foglio1").Range("A1").PasteSpecial (xlPasteValues)
NewBook.Worksheets("Foglio1").Range("A1").PasteSpecial (xlPasteFormats)
NewBook.Worksheets("Foglio1").Range("A:J").Columns.AutoFit
NewName = ThisWB.Path & "\" & NewBook.Worksheets("Foglio1").Range("A4").Value & "_Summary.xls"
If Dir(NewName) "" Then
If MsgBox("A file named '" & NewName & " already exists." & vbCr & vbCr & _
MeaName & " will now open??", vbYesNo) = vbYes Then
Workbooks.Open NewName
End If
NewBook.Close False
Exit Sub
End If
NewBook.SaveAs Filename:=NewName
NewBook.ActiveSheet.Range("A1").Select
NewBook.Close
Application.ScreenUpdating = True
err_handler:
NewName = ThisWB.Path & "\" & NewBook.Worksheets("Foglio1").Range("A4").Value & "_Summary(error).xls"
NewBook.SaveAs Filename:=NewName
NewBook.ActiveSheet.Range("A1").Select
NewBook.Close
Application.ScreenUpdating = True
End Sub