VBA, auto saving to filepath specified in cell

[sanantonio]

Hi All,

With the gracious help of you guys & gals here I've had my team quite merrily using the following VBA:

'-------------------------------------------------------------------------------------------------------
'next filter-US01458B06

    Sheets("Export").Select
On Error Resume Next
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:= _
        "US01458"
On Error Resume Next
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
        "B06"
On Error Resume Next
    Application.DisplayAlerts = False 'switching off the alert button

nPath = "K:\xxx\xxx\02\(000)\xxx\ " & ThisWorkbook.Sheets("Setup").Range("U61").Value
Set wB = Workbooks.Add
With wB
    .SaveAs filename:=nPath
End With

    Application.DisplayAlerts = False 'switching off the alert button

'Dim nPath As String
nPath = "K:\xxx\xxx\02\(000)\xxx\ " & ThisWorkbook.Sheets("Setup").Range("U61").Value
ThisWorkbook.Sheets("Export").Range("A1:C99999").SpecialCells(xlCellTypeVisible).Copy
Workbooks(wB.Name).Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Workbooks(wB.Name).Close SaveChanges:=True
    
'US01458B16

    Sheets("Export").Select
On Error Resume Next
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:= _
        "US01458"
On Error Resume Next
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
        "B16"
On Error Resume Next
    Application.DisplayAlerts = False 'switching off the alert button

nPath = "K:\xxx\xxx\02\(000)\xxx\ " & ThisWorkbook.Sheets("Setup").Range("V61").Value
Set wB = Workbooks.Add
With wB
    .SaveAs filename:=nPath
End With

    Application.DisplayAlerts = False 'switching off the alert button

'Dim nPath As String
nPath = "K:\xxx\xxx\02\(000)\xxx\ " & ThisWorkbook.Sheets("Setup").Range("V61").Value
ThisWorkbook.Sheets("Export").Range("A1:C99999").SpecialCells(xlCellTypeVisible).Copy
Workbooks(wB.Name).Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Workbooks(wB.Name).Close SaveChanges:=True

Essentially this filters a table of data, in the example above by our site designated "US01458" and across our two order areas B06 and B16 then copies the filtered information to a new workbook. Then saves that workbook as the name specified in U61for B06 and V61 for B16. Whilst the filename changes the filepath has always been this specific location on the K Drive, which is our shared company drive.

The modification we now want to make to this is to have the filepath also reference a separate cell reference so that users can save this to the laptop's C/Drive, which will save time as (Long story short we've been told to work from home consistently as the business downsizes it's office space and the K drive is slow when working remote).

I want to retain the separate cell reference for the filename if possible. Just replace:

nPath = "K:\xxx\xxx\02\(000)\xxx\ "

this part with a specific cell reference. So Q2 for example.

Thanks in advance for any help! I've tried a few homebrew and a few solutions found online and don't seem to have had any luck.

 

[Joe4]

If I am understanding you correctly, it sounds like you just want this, right?

nPath = Range("Q2")

Note that if you do not have the last back-slash in the file path, you may need to use:

nPath = Range("Q2") & "\"

If you aren't sure whether or not they included the last backslash, you can check for it, i.e.

If Right(Range("Q2"),1) = "\" Then
    nPath = Range("Q2")
Else
    nPath = Range("Q2") & "\"
End If

 

[LazyBug]

Hello!

Try

nPath = Range("Q2").Value

if Q2 contains string with a full path or

nPath = "K:\xxx\xxx\02\(000)\xxx\" & Range("Q2").Value

if in Q2 just an end part of path.

 

[sanantonio]

Thanks fellas. They worked a treat!

 

[Joe4]

You are welcome!
Glad we could help.

 

[sanantonio]

Hi All. This was working initially but now I have encountered a very peculiar error.

So I have cell Z2 setup with an if. So that if the input cell (D16) is blank it returns a default filepath location (K:\xxx\xxx\xxx\Ordering\US90005\). But regardless of what is in Z2, whether it be a manually written in code into the input cell or whether it is the default filepath location the macro only ever saves in the last location you saved something.

So if you just saved a blank workbook to your desktop it'll save all the macro created excels to the desktop. Or if you opened, made 1 change, then closed and saved an older document on the shared drive anywhere it'll save all your macro excels to there.

Below is the code, but it's one heck of a strange problem??

    Sheets("Export").Select
On Error Resume Next
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=3, Criteria1:= _
        "US08036"
On Error Resume Next
    ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=8, Criteria1:= _
        "B16"
On Error Resume Next
    Application.DisplayAlerts = False 'switching off the alert button

nPath = Range ("Z2") & ThisWorkbook.Sheets("Setup").Range("V55").Value
Set wB = Workbooks.Add
With wB
    .SaveAs filename:=nPath
End With

    Application.DisplayAlerts = False 'switching off the alert button

'Dim nPath As String
nPath = Range ("z2") & ThisWorkbook.Sheets("Setup").Range("V55").Value
ThisWorkbook.Sheets("Export").Range("A1:C99999").SpecialCells(xlCellTypeVisible).Copy
Workbooks(wB.Name).Sheets("Sheet1").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Workbooks(wB.Name).Close SaveChanges:=True

Anyone see anything in the code that would make this happen? Or is it because of restrictions on our work computers? Ever encountered this error before?

 

[sanantonio]

Hey All, anyone sure as to a solution? Why the macro would always save in the last saved location, rather than the specified filepath?