Error Handling on save location referenced in cell

SammyCRX

New Member
Joined
Aug 15, 2016
Messages
32
Hi,

This is probably a really easy one, but saving files etc. isn't my strong point (but I'd like to think I'm getting better!). In the code below I just require some error handling so that if the location referenced in cell B7 isn't valid then it'll exit out of the macro, keep everything as it is with no data loss, but prompt the user to amend the save location. Any ideas please?

Thanks,
Sam

VBA Code:
Sub SaveFiles1()
'
' SaveFiles1 Macro
' Saves files in correct formats
'
    'Check user wants to continue
    If MsgBox("This will save all data and exit the spreadsheet - are you sure?", vbOKCancel) = vbCancel Then Exit Sub
   
    ActiveWorkbook.Unprotect Password:="CREATOR"
    Application.ScreenUpdating = False
   
    'Gets file name for Product Importer Template
    ProductImporterName = ActiveWorkbook.Name
   

'Sets out file names
    Dim myMonth As String
    myMonth = Format(Sheets("Suppliers").Range("G2"), "mmmm")
   
    Dim myTicket As String
    myTicket = Sheets("Importer Template").Range("B3")

                Dim myFilePathOriginal As String
                myFilePathOriginal = Sheets("Importer Template").Range("B7")

                Dim myFilePathImport As String
                myFilePathImport = Sheets("Importer Template").Range("B7")

                Dim myFileName As String
                myFileName = myMonth & "_" & myTicket

Application.DisplayAlerts = False

'   Adds workbook for 'Importer Template' to be copied to

    Workbooks.Add
    ImportData = ActiveWorkbook.Name
    Windows(ImportData).Activate
    'Add new sheets
    ActiveSheet.Name = "Import File"
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "CLI List"
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Summary"
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "End Dated Products"
    'Copy data across
    Windows(ProductImporterName).Activate
    Sheets("Load File").Select
    Cells.Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("Import File").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows(ProductImporterName).Activate
    Sheets("CLI List").Select
    Cells.Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("CLI List").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Windows(ProductImporterName).Activate
    Sheets("Summary").Select
    Cells.Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("Summary").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Windows(ProductImporterName).Activate
    Sheets("End Dated Products").Select
    Cells.Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("End Dated Products").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Copies formats across
    Windows(ProductImporterName).Activate
    Sheets("Load File").Select
    Columns("A:U").Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("Import File").Select
    Columns("A:U").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
   
'Copies formats across
    Windows(ProductImporterName).Activate
    Sheets("CLI List").Select
    Columns("A:N").Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("CLI List").Select
    Columns("A:N").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
   
'Copies formats across
    Windows(ProductImporterName).Activate
    Sheets("Summary").Select
    Columns("A:C").Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("Summary").Select
    Columns("A:C").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
   
'Copies formats across
    Windows(ProductImporterName).Activate
    Sheets("End Dated Products").Select
    Columns("A:B").Select
    Selection.Copy
    Windows(ImportData).Activate
    Sheets("End Dated Products").Select
    Columns("A:B").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select

Application.DisplayAlerts = True

    Sheets("Import File").Select
    ActiveWorkbook.SaveAs Filename:= _
        myFilePathImport & "Evonex Import Data_" & myFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
   
   
'Clear out old data
    Windows(ProductImporterName).Activate
    Sheets("Importer Template").Select
    Application.Run "ResetSheets2"

    Application.ScreenUpdating = True

    'Close and save
    ActiveWindow.Close True
'
End Sub
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.

SammyCRX

New Member
Joined
Aug 15, 2016
Messages
32
Perhaps the question should be - how do I check if the file path specified in a cell is valid? I've been reading up online and I'm sure it's straightforward enough, but I've had no luck so far in finding a solution.
 

SammyCRX

New Member
Joined
Aug 15, 2016
Messages
32
Oh well, no matter... in the end I used the excellent Ron DeBruin site to find the solution. In case it helps anyone in future:

VBA Code:
    'Tests if the file path exists
    Dim FilePath As String
    Dim TestStr As String

    FilePath = Sheets("Importer Template").Range("B7")

    TestStr = ""
    On Error Resume Next
    TestStr = Dir(FilePath)
    On Error GoTo 0
    If TestStr = "" Then
        MsgBox "File path in cell B7 doesn't exist"
    Exit Sub
    Else
    End If
 

Watch MrExcel Video

Forum statistics

Threads
1,130,042
Messages
5,639,731
Members
417,108
Latest member
Thein Than

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top