VBA file path location from named sheet

[Pheonix2332]

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 -

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

 

[Fluff]

Glad we could help & thanks for the feedback.