Changing "," to ";" in split .csv files

[CamBF]

Hi guys,

Need help making changes to a code I have had previously put together for me.

The code below splits a .txt file into multiple .csv files and archives the original .txt file into a folder.

I need it to also replace all the "," characters in the .csv files it generates with ";".

Thanks

Sub GroupAndExportCsv()

Dim csvFile As String

Dim outputDir As String

Dim supercededDir As String

Dim delimiter As String

Dim line As String

Dim header As Variant

Dim FSO As Object

Dim fileStream As Object

Dim outputStream As Object

Dim data As Variant

Dim groups As Object

Dim groupName As Variant

Dim i As Integer

Dim isFirstLine As Boolean

Dim fd As FileDialog

Dim filePath As String



' Open file dialog to select the CSV file

Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd

.Title = "Select CSV File"

.Filters.Add "CSV Files", "*.txt", 1

.AllowMultiSelect = False

If .Show = -1 Then

csvFile = .SelectedItems(1)

Else

MsgBox "No file selected. Exiting..."

Exit Sub

End If

End With



' Set parameters

delimiter = ","

outputDir = fd.InitialFileName

supercededDir = outputDir & "_superceded\"



' Set header

header = Array("ID", "X(m)", "Y(m)", "Z(m)", "Layer")



' Create FileSystemObject and Dictionary objects

Set FSO = CreateObject("Scripting.FileSystemObject")

Set groups = CreateObject("Scripting.Dictionary")



' If outputDir does not exist, create it

If Not FSO.FolderExists(outputDir) Then

FSO.CreateFolder (outputDir)

End If



' If supercededDir does not exist, create it

If Not FSO.FolderExists(supercededDir) Then

FSO.CreateFolder (supercededDir)

End If



' Open the original CSV file

Set fileStream = FSO.OpenTextFile(csvFile, 1, False)



' Initialize as the first line

isFirstLine = True



' Read file line data and group by the 5th column

Do While Not fileStream.AtEndOfStream

line = fileStream.ReadLine



' Check if it is the first line

If isFirstLine Then

isFirstLine = False

Else

data = Split(line, delimiter)

groupName = Replace(data(4), " ", "") ' Group by the 5th column



If Not groups.Exists(groupName) Then

groups.Add groupName, New Collection

End If



' Remove spaces from each element and join only the first 5 columns

groups(groupName).Add Join(Array(Replace(data(0), " ", ""), Replace(data(1), " ", ""), Replace(data(2), " ", ""), Replace(data(3), " ", ""), Replace(data(4), " ", "")), delimiter)

End If

Loop



' Close the original CSV file

fileStream.Close



' Write each group data to different CSV files

For Each groupName In groups.Keys

Set outputStream = FSO.CreateTextFile(outputDir & groupName & ".csv", True, False)



' Write header

outputStream.WriteLine Join(header, delimiter)



' Write data

For i = 1 To groups(groupName).Count

outputStream.WriteLine groups(groupName).Item(i)

Next i



outputStream.Close

Next groupName



' Move the original .txt file to the _superceded directory

FSO.MoveFile csvFile, supercededDir & FSO.GetFileName(csvFile)



' Cleanup

Set fileStream = Nothing

Set outputStream = Nothing

Set groups = Nothing

Set FSO = Nothing

End Sub

 

[CamBF]

Link below to a .txt file to run VBA code on:

Dropbox

 

[HongRu]

I need it to also replace all the "," characters in the .csv files it generates with ";".

The .csv files from the original .txt file have no "," characters since the code sets delimiter ="," .
In other words, all "," in the files will be eliminated.

 

[HongRu]

OK.
I guess you want to replace all "," in the new .csv files with ";" .
It can be done, but the csv (Comma-Separated Values) files without "," (comma) will be strange somehow...
It is really what you want ?

 

[HongRu]

Try.

Sub GroupAndExportCsv()

    Dim csvFile As String
    Dim outputDir As String
    Dim supercededDir As String
    Dim delimiter As String
    Dim line As String
    Dim header As Variant
    Dim FSO As Object
    Dim fileStream As Object
    Dim outputStream As Object
    Dim data As Variant
    Dim groups As Object
    Dim groupName As Variant
    Dim i As Integer
    Dim isFirstLine As Boolean
    Dim fd As FileDialog
    Dim filePath As String

    ' Open file dialog to select the CSV file
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "Select CSV File"
        .Filters.Add "CSV Files", "*.txt", 1
        .AllowMultiSelect = False
        If .Show = -1 Then
            csvFile = .SelectedItems(1)
        Else
            MsgBox "No file selected. Exiting..."
            Exit Sub
        End If
    End With

    ' Set parameters
    delimiter = ","
    outputDir = fd.InitialFileName
    supercededDir = outputDir & "_superceded\"

    ' Set header
    header = Array("ID", "X(m)", "Y(m)", "Z(m)", "Layer")

    ' Create FileSystemObject and Dictionary objects
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set groups = CreateObject("Scripting.Dictionary")

    ' If outputDir does not exist, create it
    If Not FSO.FolderExists(outputDir) Then
        FSO.CreateFolder (outputDir)
    End If

    ' If supercededDir does not exist, create it
    If Not FSO.FolderExists(supercededDir) Then
        FSO.CreateFolder (supercededDir)
    End If

    ' Open the original CSV file
    Set fileStream = FSO.OpenTextFile(csvFile, 1, False)

    ' Initialize as the first line
    isFirstLine = True

    ' Read file line data and group by the 5th column
    Do While Not fileStream.AtEndOfStream
        line = fileStream.ReadLine

        ' Check if it is the first line
        If isFirstLine Then
            isFirstLine = False
        Else
            data = Split(line, delimiter)
            groupName = Replace(data(4), " ", "") ' Group by the 5th column

            If Not groups.Exists(groupName) Then
                groups.Add groupName, New Collection
            End If

            ' Remove spaces from each element and join only the first 5 columns
            groups(groupName).Add Join(Array(Replace(data(0), " ", ""), Replace(data(1), " ", ""), Replace(data(2), " ", ""), Replace(data(3), " ", ""), Replace(data(4), " ", "")), delimiter)
        End If
    Loop

    ' Close the original CSV file
    fileStream.Close

    ' Write each group data to different CSV files
    For Each groupName In groups.Keys
        Set outputStream = FSO.CreateTextFile(outputDir & groupName & ".csv", True, False)

        ' Write header
        outputStream.WriteLine Replace(Join(header, delimiter), delimiter, ";")

        ' Write data
        For i = 1 To groups(groupName).Count
            ' Replace commas with semicolons
            outputStream.WriteLine Replace(groups(groupName).Item(i), delimiter, ";")
        Next i

        outputStream.Close
    Next groupName

    ' Move the original .txt file to the _superceded directory
    FSO.MoveFile csvFile, supercededDir & FSO.GetFileName(csvFile)

    ' Cleanup
    Set fileStream = Nothing
    Set outputStream = Nothing
    Set groups = Nothing
    Set FSO = Nothing

End Sub

 

[CamBF]

Thank you HongRu, that works perfectly

Really appreciate your help!