Split CSV file based on column data

[M0rph]

We are now running reports that will generate a (comma) CSV file with approx 5000 entries per file. I'd like to know how I can split this file into seperate (comma) CSV files based upon the name within specific column (instructor).

Ideally, when complete, each CSV file would:
- have the new CSV files named after the name in the instructor column
- contain the header row (A1 - P1)
- All rows that include the same instructor name from COLUMN N"

I'm open to different method to do this in as long as it works. This is new territory for me, so might take a little to understand how to do it.

An example of the CSV file shown in Excel would look like this:

Q1	Q2	Q3	Q4	Q5	Q6	Q7	Q8	Q9	Q10	Q11	Faculty	Course	Instructor	Section	Email
5	4	6	8	6	8	6	4	6	8	4	EDU	1000	Joe Blow	A	joe@email.com
7	6	4	3	4	6	8	2	8	2	8	ART	2500	Pam Doe	C	pam@email.com
1	8	7	6	2	5	4	6	3	6	4	EDU	1000	Joe Blow	A	joe@email.com
7	6	3	5	2	4	3	3	4	3	5	SCI	3500	Frank Tank	C	frank@email.com
5	4	5	4	5	2	6	5	6	4	6	EDU	3040	Joe Blow	C	joe@email.com
2	2	5	6	3	4	2	5	5	4	5	PHY	2050	Frank Tank	B	frank@email.com
3	3	5	5	8	2	5	8	2	6	2	ART	4000	Pam Doe	A	pam@email.com

 

[igold]

Hi M0rph, welcome to the MrExcel Forum.

Does this get you close to what you want to do.

To use, copy this code to a new .xlsm workbook and save it (which you will have to do just once). Open this new workbook and the CSV file you want to work with. Only those two Workbooks should be open. The code will save the newly created CSV workbooks to the same file location as the original CSV is saved in.

Sub SplitCSV()
    
    Dim arr
    Dim wb As Workbook, Nwb As Workbook, CeSV As Workbook
    Dim typ As Long, x As Long, i As Long, ct As Long
    Dim rng As Range
    Dim FilePath As String
    
    Application.ScreenUpdating = False
    ct = Application.Workbooks.Count
    If ct <> 2 Then
        MsgBox "Please Close All Other Workbooks except for This One and Your CSV File!"
        Exit Sub
    End If
    For Each CeSV In Application.Workbooks
        typ = CeSV.FileFormat
        If typ = 6 Then CeSV.Activate
        FilePath = Application.ActiveWorkbook.Path
        Exit For
    Next
    ActiveSheet.AutoFilter.ShowAllData
    arr = Range("N2:N" & Cells(Rows.Count, 14).End(xlUp).Row)
    With CreateObject("Scripting.Dictionary")
    For x = LBound(arr) To UBound(arr)
        If Not IsMissing(arr(x, 1)) Then .Item(arr(x, 1)) = 1
    Next
    arr = .Keys
    End With
    For i = LBound(arr) To UBound(arr)
        ActiveSheet.Range("N1").AutoFilter
        ActiveSheet.Range("$A$1:$Q" & Cells(Rows.Count, 14).End(xlUp).Row).AutoFilter Field:=14, Criteria1:=arr(i), Operator:=xlFilterValues
        Set rng = ActiveSheet.AutoFilter.Range
        Set wb = Workbooks.Add
        rng.Copy Range("A1")
        Set Nwb = ActiveWorkbook
        Nwb.SaveAs FilePath & "\" & arr(i) & ".csv", FileFormat:=xlCSV
        Nwb.Close SaveChanges:=True
    Next
    ActiveSheet.AutoFilter.ShowAllData
    Application.ScreenUpdating = True
    
End Sub