How to get rid of unwanted commas at end of string in CSV file

Question

I have made the following code where the aim is to save two ranges into a CSV file:

Sub Export_range_to_CSV()
    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim range1 As Range
    Dim range2 As Range
    Set range1 = Sheets("sheet1").Range("G2:G4")
    Set range2 = Sheets("sheet1").Range("G5:H53")

    Application.DisplayAlerts = False
    On Error GoTo err

    Set myWB = ThisWorkbook
    myCSVFileName = "filepath" & "\" & "name" & VBA.Format(VBA.Now, "yyyymmdd_hhmm") & ".csv"
    
    range1.Copy

    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        range2.Copy
        .Sheets(1).Range("A4").PasteSpecial xlPasteValues
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With
err:
    Application.DisplayAlerts = True
End Sub

The code above does the job, but for range1 it has commas at the end of the string when saved as CSV. I need to remove these in order for a job downstream to work. How do I get rid of the commas at the end of range1?

This is how it looks once saved as the CSV file:

range1

- # X=Y, <- need to remove these commas
- # Z=U,
- # M=Q,

range2

- datetime,quantity
- 2021-03-05 23:00:00+00:00,17
- 2021-03-05 23:30:00+00:00,17
- 2021-03-06 00:00:00+00:00,17
- 2021-03-06 00:30:00+00:00,17

I think the problem comes from range1 only having a single column and as soon as range2 comes into play it assumes range1 should be two columns as well.

Answer 1

Remove Trailing Comma

• You run exportRangesToCSV, while removeTrailingCommaInTextFile is being called near the end, and removeTrailingComma is being called by removeTrailingCommaInTextFile.
• I tested it and it works, but keep in mind that I know very little about manipulating text files (2nd procedure) and that this is more or less the first Regex I've ever written (3rd procedure). It took me 'ages' to write them (not complaining). The 1st procedure is where I'm 'at home'.
• Note the example of a classic error-handling routine in the 2nd procedure (yours is unacceptable: you're missing the Resume part). You could easily apply it to the 1st procedure.
• Don't forget to adjust the values in the constants section.

The Code

Option Explicit

Sub exportRangesToCSV()
    
    Const sName As String = "Sheet1"
    Const sAddr As String = "G2:G4,G5:H53"
    
    Const dFolderPath As String = "C:\Test"
    Const dLeftBaseName As String = "Name"
    Const dTimeFormat As String = "yyyymmdd_hhmm"
    Const dFileExtension As String = ".csv"
    Const dAddr As String = "A1"
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim rg As Range: Set rg = wb.Worksheets(sName).Range(sAddr)
    
    Dim dFilePath As String
    dFilePath = dFolderPath & "\" & dLeftBaseName _
        & VBA.Format(VBA.Now, dTimeFormat) & dFileExtension
    
    Application.ScreenUpdating = False
    With Workbooks.Add()
        Dim dCell As Range: Set dCell = .Worksheets(1).Range(dAddr)
        Dim srg As Range
        For Each srg In rg.Areas
            dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
            Set dCell = dCell.Offset(srg.Rows.Count)
        Next srg
        Application.DisplayAlerts = False
        .SaveAs dFilePath, xlCSV
        Application.DisplayAlerts = True
        .Close False
    End With
    Application.ScreenUpdating = True
    
    removeTrailingCommaInTextFile dFilePath, True
    
    'wb.FollowHyperlink dFolderPath

End Sub

Sub removeTrailingCommaInTextFile( _
        ByVal FilePath As String, _
        Optional ByVal removeAllOccurrences As Boolean = False)
    Const ProcName As String = "removeTrailingCommaInTextFile"
    On Error GoTo clearError

    Dim TextFile As Long: TextFile = FreeFile
    Dim TempString As String
    Open FilePath For Input As TextFile
    TempString = Input(LOF(TextFile), TextFile)
    Close TextFile
    Open FilePath For Output As TextFile
    Print #TextFile, removeTrailingComma(TempString, removeAllOccurrences)
    Close TextFile

ProcExit:
    Exit Sub
clearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & err.Number & "':" & vbLf _
              & "        " & err.Description
    Resume ProcExit
End Sub

Function removeTrailingComma( _
    ByVal SearchString As String, _
    Optional ByVal removeAllOccurrences As Boolean = False) _
As String
    With CreateObject("VBScript.RegExp")
        .Global = True
        .MultiLine = True
        If removeAllOccurrences Then
            .Pattern = ",+$"
        Else
            .Pattern = ",$"
        End If
        removeTrailingComma = .Replace(SearchString, "")
    End With
End Function

Edit

• This solution will write directly to the text file without exporting. It may become slow if there are too many cells.

Arrays

Sub exportRangesToCSVArrays()
    
    Const sName As String = "Sheet1"
    Const sAddr As String = "G2:G4,G5:H53"
    
    Const dFolderPath As String = "C:\Test"
    Const dLeftBaseName As String = "Name"
    Const dTimeFormat As String = "yyyymmdd_hhmm"
    Const dFileExtension As String = ".csv"
    Const dAddr As String = "A1"
    Const Delimiter As String = ","
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim rg As Range: Set rg = wb.Worksheets(sName).Range(sAddr)
    
    Dim aCount As Long: aCount = rg.Areas.Count
    Dim Data As Variant: ReDim Data(1 To aCount)
    Dim rData() As Long: ReDim rData(1 To aCount)
    Dim cData() As Long: ReDim cData(1 To aCount)
    Dim OneCell As Variant: ReDim OneCell(1 To 1, 1 To 1)
    Dim srg As Range
    Dim srCount As Long, scCount As Long
    Dim drCount As Long, dcCount As Long
    Dim n As Long
    
    For Each srg In rg.Areas
        n = n + 1
        srCount = srg.Rows.Count: scCount = srg.Columns.Count
        rData(n) = srCount: cData(n) = scCount
        If srCount > 1 Or scCount > 1 Then
            Data(n) = srg.Value
        Else
            Data(n) = OneCell: Data(1, 1) = srg.Value
        End If
        drCount = drCount + srCount
        If scCount > dcCount Then
            dcCount = scCount
        End If
    Next srg
    
    Dim Result() As String: ReDim Result(1 To drCount)
    Dim r As Long, i As Long, j As Long
    For n = 1 To aCount
        For i = 1 To rData(n)
            r = r + 1
            For j = 1 To cData(n)
                Result(r) = Result(r) & CStr(Data(n)(i, j)) & Delimiter
            Next j
            Result(r) = removeTrailingComma(Result(r), True)
        Next i
    Next n
    
    Dim dFilePath As String
    dFilePath = dFolderPath & "\" & dLeftBaseName _
        & VBA.Format(VBA.Now, dTimeFormat) & dFileExtension
    
    Dim TextFile As Long: TextFile = FreeFile
    Dim TempString As String
    Open dFilePath For Output As TextFile
    Print #TextFile, Join(Result, vbLf)
    Close TextFile

    'wb.FollowHyperlink dFolderPath

End Sub

Answer 2

The last column is calculated by checking the last column of both the ranges. Whichever is higher will be taken. Let me explain it.

Let's say the data is till column J

Set range1 = Sheets("sheet1").Range("G2:G4")
Set range2 = Sheets("sheet1").Range("G5:J53")

Then in this scenario, there will be 3 commas added. Similarly if the last column is K in range2 and last column is H in range1 then there will be 3 commas added to the 1st range.

The same holds true when you reverse the range

Set range1 = Sheets("sheet1").Range("G5:J53")
Set range2 = Sheets("sheet1").Range("G2:G4")

Now the 2nd range will have extra commas

Solution

Read the data in an array and then remove the last comma. So once your Csv file is written, pass the file to this procedure and it will take care of the rest

The below code reads the csv in an array in one go and then checks every line if it has a , on the right. And if it has then it removes it. Finally it deletes the old csv and writes the new file by putting the array in the text file in one go. I have commented the code so you should not have a problem understanding it. But if you do then simply ask.

'~~> Example usage
Sub Sample()
    CleanCsv "C:\Users\Siddharth Rout\Desktop\aaa.txt"
End Sub

'~~> Cleans csv
Sub CleanCsv(fl As String)
    Dim MyData As String, strData() As String
    Dim i As Long
    
    '~~> Read the file in one go into an array
    Open fl For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1
    strData() = Split(MyData, vbCrLf)
    
    '~~> Check for "," and remove
    For i = LBound(strData) To UBound(strData)
        If Right(strData(i), 1) = "," Then
            Do While Right(strData(i), 1) = ","
                strData(i) = Left(strData(i), Len(strData(i)) - 1)
            Loop
        End If
    Next i
    
    '~~> Kill old file
    Kill fl
    
    '~~> Output the array in one go into a text file
    Dim ff As Long
    ff = FreeFile
    Open fl For Binary As #ff
    
    Put #ff, , Join(strData, vbCrLf)
    
    Close #ff
End Sub