Converting .txt file to .csv, splitting files and adding rows

[CamBF]

Hi all,

Needing urgent help please to put together a VBA code that will do the following, assisting with speeding up workflow by removing time consuming manual editing.

Currently we export from our software a .txt file that contains data relevant to multiple points we have modeled. The data in the .txt file is separated by a comma, please refer to the attached screenshot. However it is not a .csv file format. Also if .txt file is opened in Excel all data is in column A only.

What we need is a VBA code that will open a window to locate the .txt file that contains this information.

Then once the file is selected through the window and open / ok is pressed to close the window, the VBA code will do the following:

1. Delete the top row of text in the selected file.

2. Search the data in the .txt file after the 4th comma in each row and group the data based on the text found, refer to the pink column in attached screenshot.

3. For each "group", for example all rows with "GRIDS", we need the code to create a .csv file in the same location as the selected .txt file, which contains only the rows with "GRIDS".

4. The code then needs to do the same for all other "groups" of text as per step 3 above. Essentially creating multiple separate .csv files for each "group". So looking at the attached screenshot there would be one .csv file for GRIDS, another .csv file for "STAGE 1 - SLAB POINTS" and so on. The file names will need to be the name of the "group".

5. In each .csv file created, a row of text will need to be added at the top. It will need to be: ID,X (m),Y (m),Z (m),Layer

6. Once all .csv files have been created, the original selected .txt file will need to be shifted into a new created folder in the same location, named "_superceded", if there is already a folder in the location named _superceded, no need for the code to try create a second folder, just move the .txt file into the existing folder.

Example .txt file can be downloaded here: Dropbox

Thanks guys

 

[HongRu]

Try.
Before executing the codes, please confirm the parameters of csvFile, outputDir and supercededDir.

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

    ' Set parameters
    csvFile = "C:\Data\COMBINED.txt"
    outputDir = "C:\Data\"
    supercededDir = "C:\Data\_superceded\"
    delimiter = ","
    
    ' 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 last 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 = data(UBound(data)) ' Group by the last column
            
            If Not groups.Exists(groupName) Then
                groups.Add groupName, New Collection
            End If
            
            groups(groupName).Add line
        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]

Hi HongRu,

I have tested it and it is very close, just a couple of things

1. Can we please have it so that when you run the code a window appears so that you can go find the .txt file and select it? All .csv files generated at the same location as the .txt file that you select. _superceded folder also created at that location.

2. If the text file has more than 5x columns, please have it remove all text after the end of the 5th column. For example, if the .txt file has "A12,0,27,29.7,GRIDS,MISC", have the code remove the ",MISC" from each row.

3. Could the code also please remove all spaces (" ") in the files.

Thank you

 

[HongRu]

3. Could the code also please remove all spaces (" ") in the files.

What does this mean?
1. "STR3-WP-25 " becomes "STR3-WP-25" ? (trim spaces before and after words.)
2 ."FIRE STAIRS 3 - WALL POI" becomes "FIRESTAIRS3-WALLPOI" ? (remove all spaces wherever)
3. Remove Items of which "ID" is empty ?
Which one ?

 

[CamBF]

Hi HongRu,

Item 2 above please, that's what I am trying to request

2 ."FIRE STAIRS 3 - WALL POI" becomes "FIRESTAIRS3-WALLPOI" ? (remove all spaces wherever)

 

[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 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

 

[Fuji]

If source txt file is always sorted by Desc (Layer) column.

Sub test()
    Dim fn$, myDir$, s$, x, y, i&, ii&, h, n&, temp
    fn = Application.GetOpenFilename("TextFile,*.txt")
    If fn = "False" Then Exit Sub
    x = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll, vbNewLine)
    h = "ID,X (m),Y (m),Z (m),Layer"
    myDir = Left$(fn, InStrRev(fn, "\"))
    s = "_superceded"
    If Dir(myDir & s, vbDirectory) = "" Then MkDir myDir & s
    FileCopy fn, myDir & s & "\" & Mid$(fn, InStrRev(fn, "\") + 1)
    Kill fn
    For i = 1 To UBound(x)
        y = Application.Trim(Split(x(i), ",")): s = y(UBound(y))
        If temp <> s Then
            temp = s: x(n) = h: ii = 0
            Do While temp = s
               x(n) = Join(Array(x(n), Join(y, ",")), vbNewLine)
               ii = ii + 1
               If i + ii > UBound(x) Then Exit Do
               y = Application.Trim(Split(x(i + ii), ","))
               s = y(UBound(y))
            Loop
            i = i + ii - 1: n = n + 1
        End If
    Next
    For i = 0 To n - 1
        y = Split(x(i), vbNewLine)
        y = Split(y(1), ",")(4)
        Open myDir & Split(Split(x(i), vbNewLine)(1), ",")(4) & ".csv" For Output As #1
            Print #1, x(i);
        Close #1
    Next
    MsgBox "Done"
End Sub