Hi all! I am having some issues adding a new requirement to my existing VBA code. This code works fine as is (although it is a bit slow to run), please forgive me as I am still learning. My new requirement is to add error handling that will advise the user if the file name already exists AND offer the user the option to overwrite the file (or not). I am having issues adding this on my own, as all the examples I have seen have te path and file name hard coded into the VBA code. But my file is a template that auto-generates a filename based on 3 cell variables.
Code
Sub Save_WeeklyFile()
Dim fName As String ' Output File Name
Dim Path1 As String ' Path name (current directory)
Dim xlD As Workbook ' Output file
Dim xlS As Workbook ' THIS workbook
Dim shS As Worksheet ' Worksheets in current workbook
Dim mySheetNames() As Variant
' Optimize Macro Speed
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayAlerts = False
' Format to Generate Dynamic Name based on variables on sheet (Data)
' Sheet Name where every variables located: data
' File Name: C3
' Week #: J3
' Period Ending: R3
Path1 = ThisWorkbook.Path
fName = Sheets("Main").Range("C3").Value & " - Week #" & Range("J3").Value & " - Period Ending " & Format(Range("R3").Value, "mm-dd-yy") & ".xlsx"
Set xlS = ThisWorkbook
' Create the new workbook
Set xlD = Workbooks.Add
' Copy sheets in
For Each shS In xlS.Sheets
If shS.Name <> "Main" Then
shS.Copy after:=xlD.Sheets(Sheets.Count)
xlD.Sheets(Sheets.Count).Name = shS.Name
End If
Next shS
' Remove the superfluous sheets
xlD.Sheets(1).Delete ' <!-- Removes sheet1 (Main)
' Hide the code sheet
xlD.Sheets("codes").Visible = xlHidden
' Hide the code sheet
xlD.Sheets("Improvements").Visible = xlHidden
' Save the workbook
xlD.SaveAs Filename:=Path1 & "\" & fName, FileFormat:=51
'Close the workbook
xlD.save
ResetSettings:
' Reset Macro Optimization Settings
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
xlS.Close True ' <!--- ' THIS workbook
End Sub
Display More