VBA file path location from named sheet

Pheonix2332

New Member
Joined
Feb 3, 2021
Messages
6
Office Version
  1. 2013
Platform
  1. Windows
Good afternoon everyone, been struggling to see what am doing wrong with this code - been trying to have the documents saved is a specific location determined in cell D4. I had the code working to produce them directly onto my desktop but now i have had a few colleges ask to use the same macro program and they are wanting filepath they choose so it can be organised y date, is there a way I can have “<target folder path>” be chosen from a designated cell ? As am loosing my mind trying to get this to work

so far the code I have is this -
VBA Code:
Option Explicit
Const Target_Folder As String = "<Target Folder Path>"
Dim wsSource As Worksheet, wsHelper As Worksheet
Dim LastRow As Long, LastColumn As Long
Sub SplitDataset()
Dim collectionUniqueList As Collection
Dim i As Long
Set collectionUniqueList = New Collection Set wsSource = ThisWorkbook.Worksheets("masters standards")
Set wsHelper = ThisWorkbook.Worksheets("Helper") wsHelper.Cells.ClearContents
With wsSource .AutoFilterMode = False LastRow = .Cells(Rows.Count, "A").End(xlUp).Row LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
If .Range("A2").Value = "" Then
GoTo Cleanup End

If Call Init_Unique_List_Collection(collectionUniqueList, LastRow) Application.DisplayAlerts = False For i = 1 To collectionUniqueList.Count SplitWorksheet (collectionUniqueList.Item(i)) Next i ActiveSheet.AutoFilterMode = False End With Cleanup: Application.DisplayAlerts = True
Set collectionUniqueList = Nothing
Set wsSource = Nothing
Set wsHelper = Nothing
End Sub

Private Sub Init_Unique_List_Collection(ByRef col As Collection, ByVal SourceWS_LastRow As Long)
Dim LastRow As Long, RowNumber As Long wsSource.Range("G2:G" & SourceWS_LastRow).Copy wsHelper.Range("A1")
With wsHelper If Len(Trim(.Range("A1").Value)) > 0 Then LastRow = .Cells(Rows.Count, "A").End(xlUp).Row .Range("A1:A" & LastRow).RemoveDuplicates 1, xlNo LastRow = .Cells(Rows.Count, "A").End(xlUp).Row .Range("A1:A" & LastRow).Sort .Range("A1"), Header:=xlNo LastRow = .Cells(Rows.Count, "A").End(xlUp).Row On Error Resume Next For RowNumber = 1 To LastRow col.Add .Cells(RowNumber, "A").Value, CStr(.Cells(RowNumber, "A").Value) Next RowNumber
End If
End With
End Sub

Private Sub SplitWorksheet(ByVal Category_Name As Variant)
Dim wbTarget As Workbook Set wbTarget = Workbooks.Add With wsSource With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn)) .AutoFilter .Range("G1").Column, Category_Name .Copy wbTarget.Worksheets(1).Paste wbTarget.Worksheets(1).Name = Category_Name wbTarget.SaveAs Target_Folder & Category_Name & ".xlsx", 51 wbTarget.Close False
End With
End With
Set wbTarget = Nothing
End Sub
 
Last edited by a moderator:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
55,517
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

Watch MrExcel Video

Forum statistics

Threads
1,127,505
Messages
5,625,199
Members
416,080
Latest member
blemon

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