Help with code: input boxes for filepath and end to file name

[cherry_pie]

I'm really a VBA novice, but I can play around with existing codes and have a basic grasp of what they are doing but I'm quite rusty as I haven't had to do much VBA for several years and I'm a bit stumped on this one. I've been playing around for several hours and haven't been successful and get regular errors, some of which I seem to fix but then lead to other errors.

I've been using the following code to split a large dataset into individual sheets myself for a while, but I have now been asked if I can make this available to other people. I change the VBA code myself to change the filepath and date that goes on the end of the defined filename (see lines marked with ***).
But others won't necessarily know how to do this so I want to make a few amendments to the VBA so that it can be used more widely.

The first change I want to make is to make the file path and the file name extensions to be input by the user via an input box (or alternatively I'm happy to add in an additional sheet where they could input the details into cells on that sheet).

I would would like to set "Target_Folder" using input box as well as well as the date bit on the end of the file path (*** and underlined) - others may want to use a different end, no end, etc.

The second change I want to make is that prior to running the macro I manually use a "=mid" formula in the last column of the workbook, to pull out the variable used to split the data from a longer string (which is within column A of the "transaction_report" worksheet). I do this and then copy and paste the column as values prior to running the macro. I would like to add this to the code so that other users wouldn't have to worry about doing this manually.
I'm not knowledgeable enough on how all the privatesubs interact to know how to add this in. I could write the code standalone (albeit probably not paritcularly 'proper', but it would suffice), but would struggle to integrate it into the wider module.
As a further bonus, this column would be excluded when the data is copied into the individual sheets and saved. But this isn't essential.

Help would be most welcomed and appreciated as always!!

Option Explicit

**** Const Target_Folder As String = "A:\ABC\DEF\Reports"
Dim wsSource As Worksheet, wsHelper As Worksheet
Dim LastRow As Long, LastColumn As Long

Sub SplitDataset()
    
    Dim collectionUniqueList As Collection
    'store the unique list of categories that will be used to split the file
    
    Dim i As Long
    
    Set collectionUniqueList = New Collection
    
    
    Set wsSource = ThisWorkbook.Worksheets("transaction_report")
    Set wsHelper = ThisWorkbook.Worksheets("Helper")
    
    ' Clear Helper Worksheet
    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
    
    ' Unique List Column and copy to helper sheet
    wsSource.Range("K2:K" & SourceWS_LastRow).Copy wsHelper.Range("A1")
    
    With wsHelper
        
        'validation checks to find out last row of list on helper sheet and remove duplicates
        If Len(Trim(.Range("A1").Value)) > 0 Then
            
            LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
            
            .Range("A1:A" & LastRow).RemoveDuplicates 1, xlNo
            
            'resets the variable last row after the duplicates have been removed
             LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
            
            .Range("A1:A" & LastRow).Sort .Range("A1"), Header:=xlNo
            
            'reset again in case there were empty cells before the data was sorted
            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("K1").Column, Category_Name
            
            .Copy
            
            'wbTarget.Worksheets(1).PasteSpecial xlValues
            wbTarget.Worksheets(1).Paste
            wbTarget.Worksheets(1).Name = Category_Name
            
            Call Retain_Formula(wbTarget)
            
   ***    wbTarget.SaveAs Target_Folder & Category_Name & "[U] v 13 Apr 2022.xlsx[/U]", 51
            wbTarget.Close False
            
        End With
        
    End With
    
    Set wbTarget = Nothing
    
End Sub

Private Sub Retain_Formula(ByVal wb_object As Workbook)
    
    '// assuming dataset always starts at row 2
    Dim col_index As Long, target_ws_lastrow As Long
    
    For col_index = 1 To LastColumn
        
        If wsSource.Cells(2, col_index).HasFormula Then
            '// transport formula
            wb_object.Worksheets(1).Cells(2, col_index).Formula = wsSource.Cells(2, col_index).Formula
            
            '// autofill formula to the last row
            target_ws_lastrow = wb_object.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
            With wb_object.Worksheets(1)
                .Range(.Cells(2, col_index), .Cells(target_ws_lastrow, col_index)).Formula = .Cells(2, col_index).Formula
            End With
                    
        End If
    Next col_index
    
End Sub

 

[Micron]

Suggest you research msoFileDialogFolderPicker to see if you think it will help you, rather than input box for path. However, you still may need input for file name or perhaps use things like ThisWorkbook.Path & "\" or ActiveWorkbook.Name as starting points but I can't tell from your post exactly what you might need. If varied extensions are needed, it might be better to handle this with a form and force users to choose .xlsm, .xlsx etc. from a combo to avoid typos like xlxs.

If there is one user initiated event (e.g. button click event) that is able to handle all of this, whether or not all code goes into one event or calls other procedures is often only a matter of choice. I will use several procedures if they can be reused for other jobs, but if they are stand alone it's often easier to follow if it is all together.

I manually use a "=mid" formula in the last column of the workbook, to pull out the variable used to split the data from a longer string (which is within column A of the "transaction_report" worksheet)

If you can do that as a sheet formula, you eliminate the calculated column and can do it in code and not have to worry about whether or not you copy that column.

 

[cherry_pie]

I have read a post on the msoFileDialogFolderPicker and I think it would work -
The current code has the file path defined at the very beginning as a Constant and so I've deleted this and inserted the code into the Private Sub (as below) where the individual files are saved - however, this is asking for each individual file where to save it. I would like it set once but I'm not clear how I should amend the code to make it work this way.

I haven't looked into the file name bit yet so will come back later on this.

Private Sub SplitWorksheet(ByVal Category_Name As Variant)
    
    Dim wbTarget As Workbook
    
    Set wbTarget = Workbooks.Add
    
    Dim Target_Folder As String
    
    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select the file path for where the individual files will be saved"
        .ButtonName = "Select"
        If .Show = -1 Then ' if OK is pressed
            Target_Folder = .SelectedItems(1)
        End If
    End With
    
    If Target_Folder <> "" Then ' if a file was chosen
    
    With wsSource
        
        With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
            .AutoFilter .Range("K1").Column, Category_Name
            
            .Copy
            
            'wbTarget.Worksheets(1).PasteSpecial xlValues
            wbTarget.Worksheets(1).Paste
            wbTarget.Worksheets(1).Name = Category_Name
            
            Call Retain_Formula(wbTarget)
            
            wbTarget.SaveAs Target_Folder & Category_Name & " v 13 Apr 2022.xlsx", 51
            wbTarget.Close False
            
        End With
        
    End With
    
    End If
    Set wbTarget = Nothing
    
End Sub

 

[Micron]

this is asking for each individual file where to save it

I can see no reason for that in what you posted. You must be calling that sub in a loop in another sub then? I so, the solution would be to move the folder selection outside of the loop.
EDIT - the code in your first post is still relevant I take it. That's where the loop is that calls the sub that contains the dialog? Then yes, move the dialog outside of the loop. Maybe add parameter to the called sub and pass the path in the loop as well.

 

[cherry_pie]

Hi Micron - thank you for your help so far.

Yes the code in the first post is still relevant - I just copied the privatesub where I inserted the new code.
I'm afraid I don't understand VBA enough to understand your response, other than I need to move it elsewhere.
Could you perhaps suggest an alternative location?

I tried adding it into the first sub (Splitdataset) - but when it ran and got to the file saving private sub there was an error with the definition of "Target_Folder", so I'm guessing there was an issue with the definition continuing through into the private sub?

 

[Micron]

quick answer without really studying your code; I'm saying change this
- SplitWorksheet (collectionUniqueList.Item(i)) to SplitWorksheet (collectionUniqueList.Item(i), strPath)
- put dialog code in the 1st sub but before that line and pass the selected folder path to strPath (see next line)
- add variable strPath As String in this next part

Sub SplitDataset()
    Dim collectionUniqueList As Collection
    'store the unique list of categories that will be used to split the file
    Dim i As Long

- change Private Sub SplitWorksheet(ByVal Category_Name As Variant) to Private Sub SplitWorksheet(ByVal Category_Name As Variant, strPath As String)

See if implementing those changes works for you. What's up with the ****'s in your code? Should cause an error?

 

[cherry_pie]

quick answer without really studying your code; I'm saying change this
- SplitWorksheet (collectionUniqueList.Item(i)) to SplitWorksheet (collectionUniqueList.Item(i), strPath)
- put dialog code in the 1st sub but before that line and pass the selected folder path to strPath (see next line)
- add variable strPath As String in this next part

Sub SplitDataset()
    Dim collectionUniqueList As Collection
    'store the unique list of categories that will be used to split the file
    Dim i As Long

- change Private Sub SplitWorksheet(ByVal Category_Name As Variant) to Private Sub SplitWorksheet(ByVal Category_Name As Variant, strPath As String)

See if implementing those changes works for you. What's up with the ****'s in your code? Should cause an error?

Thanks for that - will give it a try, tomorrow probably now.
The ****s were added by me in the forum to highlight the rows that I wanted looking at - probably not the best way to do so

 

[Micron]

OK. I did look deeper and made a few changes but of course, I can't test them. I'm wondering which sub gets run first. If Sub SplitDataset() then that code sets the module level variables to Nothing, in which case the subs that run next have no worksheet objects to process. I guess that the first call is not Sub SplitDataset() then.

EDIT- actually that does look suspicious because Init_Unique_List_Collection refers to wsHelper and wsSource but doesn't declare them in that sub. It's referring to the module level declared objects, yes? So SplitDataset has to run first in order to SET those objects, yet the sub destroys them thus they can't be used later? Am I on to something here?

 

[cherry_pie]

I took the original code using this:

How to split an Excel file into multiple files using VBA - Learn Data Analysis

In this tutorial, we are going to write an automation script to split a table in Excel using VBA.

learndataanalysis.org

I did make a couple of amendments, but I don't think anything substantial.

WHen you say you've "made a few changes" where do I see these?

 

[Micron]

It seems you were going to use a path variable (Target_Folder) which would be akin to strPath that I was suggesting. Here is what I did to your code but don't feel like you have to accept the changes. At the least, it should offer some things that you can incorporate or not (such as message box if dialog is cancelled). Also, it's generally considered poor practice to use GoTo's to control code flow, so I avoid them with simple IF logic tests. Unfortunately I cannot test this so apologies if anything I did raises any errors. I still do not understand how setting those sheet objects to nothing is going to work. I think these are the relevant parts:

Sub SplitDataset()
Dim collectionUniqueList As Collection 'store the unique list of categories that will be used to split the file
Dim i As Long
Dim strPath As String

' Clear Helper Worksheet
''If Not ThisWorkbook.Worksheets("transaction_report").Range("A2") = "" Then 'if "" then there is no point in any SET statements?
If Not ThisWorkbook.Worksheets("Sheet4").Range("A2") = "" Then 'if "" then there is no point in any SET statements?
   With Application.FileDialog(msoFileDialogFolderPicker)
       .Title = "Select the file path for where the individual files will be saved"
       .ButtonName = "Select"
       If .Show = -1 Then ' if OK is pressed
          strPath = .SelectedItems(1) & "\" 'REMOVE BACKSLASH IF NOT REQUIRED HERE
       Else
           MsgBox "You cancelled folder selection. Process will now terminate."
           Exit Sub
       End If
   End With
     
    Set collectionUniqueList = New Collection
    Set wsSource = ThisWorkbook.Worksheets("transaction_report")
    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
       Call Init_Unique_List_Collection(collectionUniqueList, LastRow)
       Application.DisplayAlerts = False
       For i = 1 To collectionUniqueList.count
          SplitWorksheet collectionUniqueList.Item(i), strPath
       Next i
       ActiveSheet.AutoFilterMode = False
    End With
End If

Cleanup:
    Application.DisplayAlerts = True
    Set collectionUniqueList = Nothing
    Set wsSource = Nothing
    Set wsHelper = Nothing

End Sub

Private Sub SplitWorksheet(ByVal Category_Name As Variant, strPath As String)
Dim wbTarget As Workbook
    
Set wbTarget = Workbooks.Add
With wsSource
    With .Range(.Cells(1, 1), .Cells(LastRow, LastColumn))
       .AutoFilter .Range("K1").Column, Category_Name
       .Copy
   End With
End With
            
'wbTarget.Worksheets(1).PasteSpecial xlValues
wbTarget.Worksheets(1).Paste
wbTarget.Worksheets(1).Name = Category_Name

Call Retain_Formula(wbTarget)
            
   ''***    wbTarget.SaveAs Target_Folder & Category_Name & "[U] v 13 Apr 2022.xlsx[/U]", 51
wbTarget.Close False
Set wbTarget = Nothing
    
End Sub