sanantonio
Board Regular
- Joined
- Oct 26, 2021
- Messages
- 124
- Office Version
- 365
- Platform
- Windows
Hi All,
With the gracious help of you guys & gals here I've had my team quite merrily using the following VBA:
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:
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.
With the gracious help of you guys & gals here I've had my team quite merrily using the following VBA:
VBA Code:
'-------------------------------------------------------------------------------------------------------
'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:
VBA Code:
nPath = "K:\xxx\xxx\02\(000)\xxx\ "
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.