CODEWITHSUNDEEP
vbaexcel
DanCaparroz
DanCaparroz

Reputation: 820

Setting a delimiter to generate an export

I found a VBA code that almost fits my requirements to export data to a CSV file. I am having problems with the delimiter function.

I have the following function:

Function DelimitRange(ByVal XLArray As Variant) As String
 Const delimiter As String = ","
 Const lineFeed As String = vbCrLf
 Const removeExisitingDelimiter As Boolean = True     
 Dim rowCount As Long
 Dim colCount As Long
 Dim tempString As String


For rowCount = LBound(XLArray, 1) To UBound(XLArray, 1)
    For colCount = LBound(XLArray, 2) To UBound(XLArray, 2)

        If removeExisitingDelimiter Then
            tempString = tempString & Replace(XLArray(rowCount, colCount), delimiter, vbNullString)
        Else
            tempString = tempString & XLArray(rowCount, colCount)
        End If

        'Don't add delimiter to column end
        If colCount < UBound(XLArray, 2) Then tempString = tempString & delimiter

    Next colCount

    'Add linefeed
    If rowCount < UBound(XLArray, 1) Then tempString = tempString & lineFeed

Next rowCount

DelimitRange = tempString

End Function

This code is generating me something like that:

a,,,
d,,z,
uo,,,
u,,c,
h,,,

I need this function to generate the line skipping extra commas when there is no more characters to display at the end of each line.

I need this function to give me the following output (using the same data as the example given before:

a
d,,z
uo
u,,c
h

Thanks in advance for your help.

Upvotes: 0

Views: 175

Answers (3)

LS_ᴅᴇᴠ
LS_ᴅᴇᴠ

Reputation: 11181

Line feed change:

'Add linefeed
If rowCount < UBound(XLArray, 1) Then 
     While tempString Like "*" & delimiter
          tempString=left(tempString, Len(tempstring)-len(delimiter))
     Wend
     tempString = tempString & lineFeed
End if

Upvotes: 0

AKS
AKS

Reputation: 19841

Store the delimiters in delimitList and concatenate them only if some other element appears in the same row.

Please see the full code below:

Function DelimitRange(ByVal XLArray As Variant) As String
    Const delimiter As String = ","
    Const lineFeed As String = vbCrLf
    Const removeExisitingDelimiter As Boolean = True
    Dim rowCount As Long
    Dim colCount As Long
    Dim tempString As String

    Dim delimitList As String
    Dim currentItem As String
    Dim tempSubString As String

    For rowCount = LBound(XLArray, 1) To UBound(XLArray, 1)
        delimitList = ""
        For colCount = LBound(XLArray, 2) To UBound(XLArray, 2)
            currentItem = XLArray(rowCount, colCount)
            If Trim(currentItem) <> "" Then
                If tempSubString <> "" Then tempSubString = tempSubString & delimiter
                tempSubString = tempSubString & delimitList
                If removeExisitingDelimiter Then
                    tempSubString = tempSubString & Replace(currentItem, delimiter, vbNullString)
                Else
                    tempSubString = tempSubString & currentItem
                End If
                delimitList = ""
            Else
                delimitList = delimitList & delimiter
            End If
        Next colCount

        tempString = tempString & tempSubString
        tempSubString = ""

        'Add linefeed
        If rowCount < UBound(XLArray, 1) Then tempString = tempString & lineFeed
    Next rowCount

    DelimitRange = tempString

End Function

Upvotes: 0

shahkalpesh
shahkalpesh

Reputation: 33474

Please see the usage of currentItem in the code. Modify your code according to the code below.

dim currentItem as string

dim lastNonBlankIndex as Integer
dim dataForTheRow 
dim stringifiedRow as string

For rowCount = LBound(XLArray, 1) To UBound(XLArray, 1)
    redim dataForTheRow(LBound(XLArray, 2) To UBound(XLArray, 2))
    lastNonBlankIndex = LBound(XLArray, 2)
    For colCount = LBound(XLArray, 2) To UBound(XLArray, 2)

        If removeExisitingDelimiter Then
            currentItem = Replace(XLArray(rowCount, colCount), delimiter, vbNullString)
        Else
            currentItem = XLArray(rowCount, colCount)
        End If
        dataForTheRow(colCount) = currentItem

        If Trim(currentItem) <> "" Then
            lastNonBlankIndex = colCount
        End If

    Next colCount

    redim preserve dataForTheRow(LBound(XLArray, 2) To lastNonBlankIndex)
    stringifiedRow = Join(dataForTheRow, delimiter)

    Debug.Print stringifiedRow

    'Add linefeed
    tempString = tempString & stringifiedRow
    If rowCount < UBound(XLArray, 1) Then
        tempString = tempString & lineFeed
    End If

Next rowCount

Upvotes: 1

Related Questions