VBA to Split file into multiple CSV files based on Column

[ajayscv]

Hi All,

I have a file of received items in the company. I need to split the File into CSV files based on the Scanner Number (HHT Name). The main in this is like I would like to select the columns only which columns need to be exported in csv (from 3 -6 columns based on the Brand, with or without Header row

Please help.


[TABLE="width: 819"]
<tbody>[TR]
[TD]Barcode[/TD]
[TD]Item No.[/TD]
[TD]Description[/TD]
[TD]Variant Code[/TD]
[TD]HHT Name[/TD]
[TD]Rack Code[/TD]
[TD]Qty.[/TD]
[/TR]
[TR]
[TD]9348989137333[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009030[/TD]
[TD]109[/TD]
[TD]14[/TD]
[TD="align: right"]18[/TD]
[/TR]
[TR]
[TD]9348989137333[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009030[/TD]
[TD]109[/TD]
[TD]101[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]9348989137333[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009030[/TD]
[TD]111[/TD]
[TD]69[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD]9348989137340[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009032[/TD]
[TD]109[/TD]
[TD]14[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD]9348989137340[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009032[/TD]
[TD]111[/TD]
[TD]41[/TD]
[TD="align: right"]30[/TD]
[/TR]
[TR]
[TD]9348989137340[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009032[/TD]
[TD]111[/TD]
[TD]69[/TD]
[TD="align: right"]16[/TD]
[/TR]
[TR]
[TD]9348989137340[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009032[/TD]
[TD]113[/TD]
[TD]43[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD]9348989137357[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009034[/TD]
[TD]111[/TD]
[TD]36[/TD]
[TD="align: right"]30[/TD]
[/TR]
[TR]
[TD]9348989137357[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009034[/TD]
[TD]111[/TD]
[TD]77[/TD]
[TD="align: right"]16[/TD]
[/TR]
[TR]
[TD]9348989137357[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009034[/TD]
[TD]113[/TD]
[TD]43[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD]9348989137364[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009036[/TD]
[TD]109[/TD]
[TD]14[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]9348989137364[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009036[/TD]
[TD]111[/TD]
[TD]77[/TD]
[TD="align: right"]8[/TD]
[/TR]
[TR]
[TD]9348989137364[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009036[/TD]
[TD]112[/TD]
[TD]102[/TD]
[TD="align: right"]11[/TD]
[/TR]
[TR]
[TD]9348989137364[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]009036[/TD]
[TD]113[/TD]
[TD]43[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD]9348989137388[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]390128[/TD]
[TD]111[/TD]
[TD]40[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD]9348989137395[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]390130[/TD]
[TD]109[/TD]
[TD]38[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD]9348989137395[/TD]
[TD]R03CBOCI7[/TD]
[TD]MIRAGE AGGROFLORAL BOARDSHORT[/TD]
[TD]390130[/TD]
[TD]111[/TD]
[TD]38[/TD]
[TD="align: right"]9[/TD]
[/TR]
</tbody>[/TABLE]

 

[Yongle]

Try this
- assumes cell A1 contains the first header
- you will probably find that Variant Code values have lost their leading zeros
- is that a problem? (does Variant Code contain a leading apostrophe in your file?)

This code must be placed in the sheet code module. fldr = full path to folder where csv files are saved
(right-click sheet tab \ select View Code \ paste code in window on right)

Sub CreateCSV()
    Const fldr = "[COLOR=#ff0000]C:\folder\subFolder[/COLOR]"
    Dim fName As String, rng As Range, collHHT As New Collection, HHT As Variant, temp As Worksheet

    Set rng = Me.Range("A1").CurrentRegion
    On Error Resume Next        'required for collHHT.Add(when used in this way), SpecialCells & ShowAllData
    Application.DisplayAlerts = False: Application.ScreenUpdating = False
    
'create collection of unique values
    For Each HHT In rng.Resize(, 1).Offset(1, 4)
        collHHT.Add CStr(HHT.Value), CStr(HHT.Value)
    Next
    
'filter the data and create CSV files
    If Not AutoFilterMode Then cel.AutoFilter
    Set temp = Sheets.Add
        For Each HHT In collHHT
            temp.Cells.Clear
            rng.AutoFilter Field:=5, Criteria1:=HHT
            fName = fldr & "\" & HHT & Format(Now, " yy mm dd hhmm") & ".csv"
            rng.Offset(, 2).Resize(, 4).SpecialCells(xlCellTypeVisible).Copy temp.Cells(1)
            temp.Copy
                ActiveWorkbook.SaveAs Filename:=fName, FileFormat:=xlCSV
                ActiveWorkbook.Close
            Me.ShowAllData
        Next
    temp.Delete
    Set collHHT = Nothing
    Application.DisplayAlerts = True: Application.ScreenUpdating = True

End Sub

 

[ajayscv]

Hi Yongle,

Thank you very much for helping me on this.

This code Works very fine. But there is a mistake from my side happened in the Question. i suppose to say like every time with the report provided by different departments, i need to select some columns say Barcode, Qty or Item Number, Variant code, Qty like this based on the situation. I am not sure if possible, i would like to select manually the columns to be exported. Same code will work very fine if ability to decide which columns to exported added

 

[Yongle]

Try this
- Message box appears with HHT in header. User asked if column required. Columns appear in reverse order

Sub CreateCSV()
    Const fldr = "C:\TestArea\CSV"
    Dim fName As String, c As Long, hdr As Range, rng As Range, collHHT As New Collection, HHT As Variant, temp As Worksheet
    Set rng = Me.Range("A1").CurrentRegion
    On Error Resume Next        'required for collHHT.Add(when used in this way), SpecialCells & ShowAllData
      
'create collection of unique values
    For Each HHT In rng.Resize(, 1).Offset(1, 4)
        If HHT.Value > "" Then collHHT.Add CStr(HHT.Value), CStr(HHT.Value)
    Next
    
'filter the data and create CSV files
    Application.DisplayAlerts = False: Application.ScreenUpdating = False
    If Not AutoFilterMode Then rng.Cells(1).AutoFilter
        For Each HHT In collHHT
        'select & copy fltered data
            rng.AutoFilter Field:=5, Criteria1:=HHT
            Set temp = Sheets.Add
            rng.SpecialCells(xlCellTypeVisible).Copy temp.Cells(1)
        'select columns for each filter
            Set hdr = temp.Range(rng.Resize(1).Address)
            For c = hdr.Count To 1 Step -1
                If MsgBox(UCase(hdr.Cells(1, c).Value), vbYesNo, HHT & "     (Yes/No)") <> vbYes Then temp.Columns(c).Delete
            Next c
        'create csv
            fName = fldr & "\" & HHT & Format(Now, " yy mm dd hhmm") & ".csv"
            temp.Copy
            ActiveWorkbook.SaveAs Filename:=fName, FileFormat:=xlCSV
            ActiveWorkbook.Close
            temp.Delete
            Me.ShowAllData
        Next
    Set collHHT = Nothing
    Application.DisplayAlerts = True: Application.ScreenUpdating = True

End Sub

 

[ajayscv]

Hi Yongle,

Thank you for supporting me on this.

So far i made some changes in the Idea, Sorry for that.

But the idea got improved. May be you can amend a little bit in your Code to fit for my needs.

I have created a User Form to get the needed with the help of some other codes retrieved from internet. Please have a look at the codes and user form and advise.

The whole idea is like Double clicking the Headers in the Listbox 1 will select and copy the Header to ListBox 2 where you can adjust the order of the Columns with Up and Down command Buttons. Then Combobox1 will allow us to select the reference Column for Spliting (HHT in the initial request), and Combobox2 will select the starting row and Combobox3 will select the file type.

There is a function in the Code for selecting the Destination Folder ( GetFolder() ) which will be shooting while we press the Split button and will split the sheet into files to the selected folder.

Please see the attached Excel File in the following link for reference and advise how can we meet the needful from your code

www.ajayscv.ml

Thanks in Advance

 

[ajayscv]

Any Update Please