Reputation: 140

Appending rows to a .csv file is somehow missing the first two columns of data

I'm using a function I found here: Apend2CSV to append changed rows to a CSV file. I've used this process successfully in several different projects now, but this time it is leaving out the first two columns that I'm trying to append. As far as I can tell, everything is set up right, and I'm hoping someone with a better eye for this can point out where my problem is. The code is triggered by a Worksheet_Change event, but it is a separate procedure because it is also called by other parts of the program.

In this case, Range("A4:BB4") is supposed to get appended, but only Range("C4:BB4") actually does. This is a calculated range with formulas that account for the potential weirdness of .csv, such as quotes and commas in text, by replacing every instance of " with "" and wrapping all values in quotes before the values get appended.

Here's the code:

Sub Append2CSV()
    Sheets("ToCSV").Calculate
    Dim tmpCSV As String
    Dim f As Integer
    Const CSVFile As String = "C:\TheCSV\WBCSV.csv"

    f = FreeFile
    Open CSVFile For Append As #f

    tmpCSV = Range2CSV(Sheets("ToCSV").Range("A4:BB4"))

    Print #f, tmpCSV
    Close #f
    ThisWorkbook.Saved = True
End Sub

Private Function Range2CSV(list) As String
    Dim tmp As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
        cr = 1
        For Each r In list.Cells
            If r.Row = cr Then
                If tmp = vbNullString Then
                    tmp = r.Value
                Else
                    tmp = tmp & "," & r.Value
                End If
            Else
                cr = cr + 1
                If tmp = vbNullString Then
                    tmp = r.Value
                End If
            End If
        Next
    End If
    Range2CSV = tmp
End Function

Here's the text from the .csv file:

A,AscendSKU,UPCNumber,VendorPartNumber,MFGPartNumber,Divison,G,PhysicalQOHAtTimeOfRecord,AscendQOHAtTimeOfRecord,ChosenVendor,Status,L,M,N,O,P,Q,R,S,Cost,Price,V,W,Location,DateRecordCreated,Z,UniqueID,DateTimeSerial,CurrentAscendQOH,CurrentAscendQOO,CurrentAscendYTD,Brand,ClickHereToStartBuyerModeCategory,AH,DateRecordModified,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,ChangedDuringBuyerMode
"","11833300044D","879410002474","ST6284","ST6284","1","1181 HI-RISE 1-1/8""x31.8 STEM","","0","Hawley","","","","","","","","","","9.01","19.99","","","","42277","","42277.5861111111---...---11833300044D","42277.5861111111","","","","ELEVEN81","Parts - Stems - Mountain and Hybrid","","42277.6491435185","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6517939815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","SPE298655664","719676126357","542-3700","542-3700","1","SPEC FLATBOY GLUELESS PATCHKIT '14""","8","18","Specialized Bicycle Components","","","","","","","","","","1.44","2.99","","","","42063","","42063.7109722222---...---SPE298655664","42063.7109722222","","","","Specialized","Accessories - Flat Repair and Prevention - Patch Kits - Glueless","","42277.6569791666","","","","","","","","","","","","","","","","",""

Upvotes: 2

Answers (6)

Josh Fierro

Reputation: 140

I decided that I wanted to go ahead and try to account for the possibility of an actually blank (null) first cell within a range being appended to a .csv file without wrapping text in quotes, etc. The following is what I came up with. It works regardless of the value or lack thereof in the first cell, or anywhere else within the range being appended.

As it turns out, this method is actually super inefficient when processing thousands of rows (takes several minutes to complete.) The solution offered by Tim Williams is much faster, taking less than 6 seconds to complete.

Private Function Range2CSV(list) As String
Dim tmp As String
Dim cr As Long
Dim r As Range
Dim St As Integer

St = 1
tmp = vbNullString
If TypeName(list) = "Range" Then
    cr = list.Row
    For Each r In list.Cells
        If r.Row = cr Then
            tmp = IIf(St = 1, """" & Replace(r.Value, """", """""") & """", tmp & "," & """" & Replace(r.Value, """", """""") & """")
        Else
            tmp = IIf(r.Rows.Count Mod r.Row, tmp & vbCrLf & """" & Replace(r.Value, """", """""") & """", tmp & "," & """" & Replace(r.Value, """", """""") & """")
            cr = r.Row
        End If
        St = 2
    Next
End If
Range2CSV = tmp
End Function

Thanks to everyone for their input. Paul Bica, your answer got me the closest, but it was having problems with the concept in this line: tmp = IIf(tmp = vbNullString, r.Value2, tmp & "," & r.Value2) By defining St and checking whether the loop was looking at the first cell in the range, I was able to account for that cell having or not having a value to treat the tmp appropriately.

Upvotes: 0

Tim Williams

Reputation: 166391

I'll throw in my 2c

Sub for testing:

Sub Tester()
    Dim s, fso
    s = getCsvContent(Range("A1").CurrentRegion)
    Set fso = CreateObject("scripting.filesystemobject")
    With fso.createtextfile("C:\users\yournamehere\desktop\temp.csv", True)
        .write s
        .Close
    End With
End Sub

Function to convert a range to CSV:

Function getCsvContent(rng As Range)
    Dim data, r As Long, c As Long, sep, lb, s, tmp
    data = rng.Value
    s = ""
    lb = ""
    For r = 1 To UBound(data, 1)
        s = s & lb
        sep = ""
        For c = 1 To UBound(data, 2)
            tmp = data(r, c)
            If IsError(tmp) Then tmp = "#Error!" '<<handle errors
            If InStr(tmp, """") > 0 Then
                tmp = Replace(tmp, """", """""")
            End If
            If InStr(tmp, ",") > 0 Then
                tmp = """" & tmp & """"
            End If
            s = s & sep & tmp
            sep = ","
        Next c
        lb = vbNewLine
    Next r
    getCsvContent = s
End Function

Upvotes: 1

codersl

Reputation: 2332

Not sure that the Range2CSV function is designed to do, but this will work if you just want to get a range as a CSV string:

Private Function Range2CSV(ByVal list As Range) As String
    Dim tmp As String
    Dim r As Range
    Dim rowNum As Long

    rowNum = list.Cells(1, 1).Row
    For Each r In list.Cells
        If r.Row <> rowNum Then
            rowNum = r.Row
            tmp = Left(tmp, Len(tmp) - 1) & vbCrLf  'remove last comma and start new line
        End If
        tmp = tmp & r.Value & ","
    Next
    tmp = Left(tmp, Len(tmp) - 1) & vbCrLf  'remove final comma

    Range2CSV = tmp
End Function

Upvotes: 0

paul bica

Reputation: 10715

This works with multiple rows as well:

Private Function Range2CSV(list) As String
    Dim tmp As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
       cr = list.Row
       For Each r In list.Cells
        If r.Row = cr Then
           tmp = IIf(tmp = vbNullString, r.Value2, tmp & "," & r.Value2)
        Else
           tmp = IIf(r.Rows.Count Mod r.Row, tmp & vbCrLf & r.Value2, tmp & "," & r.Value2)
           cr = r.Row
        End If
      Next
    End If
    Range2CSV = tmp
End Function

Tested it with row A4:BB4 containing the series 1,2,3,... to 54

Result:

A,AscendSKU,UPCNumber,VendorPartNumber,MFGPartNumber,Divison,G,PhysicalQOHAtTimeOfRecord,AscendQOHAtTimeOfRecord,ChosenVendor,Status,L,M,N,O,P,Q,R,S,Cost,Price,V,W,Location,DateRecordCreated,Z,UniqueID,DateTimeSerial,CurrentAscendQOH,CurrentAscendQOO,CurrentAscendYTD,Brand,ClickHereToStartBuyerModeCategory,AH,DateRecordModified,AJ,AK,AL,AM,AN,AO,AP,AQ,AR,AS,AT,AU,AV,AW,AX,AY,ChangedDuringBuyerMode
"","11833300044D","879410002474","ST6284","ST6284","1","1181 HI-RISE 1-1/8""x31.8 STEM","","0","Hawley","","","","","","","","","","9.01","19.99","","","","42277","","42277.5861111111---...---11833300044D","42277.5861111111","","","","ELEVEN81","Parts - Stems - Mountain and Hybrid","","42277.6491435185","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","CHA27625539K","719676285276","60814-0424","60814-0424","1","16 SPEC CHAMONIX HELMET","","2","Specialized Bicycle Components","","","","","","","","","","19.6","49.99","","","","42277","","42277.5841550926---...---CHA27625539K","42277.5841550926","","","","Specialized","Accessories - Helmets - Road - z.Mens","","42277.6491666666","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","WMS291257455","072774380459","38045","38045","1","WM SOLID RR AXLE SET 3/8x26x126x175","0","0","J & B Importers","","","","","","","","","","1.69","5.99","","","","42041","","42041.6198495370---...---WMS291257455","42041.619849537","","","","WHEEL MASTER","Parts - Hubs - Axles and Nuts and Cones","","42277.6496064815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6517939815","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","FLS17361201Z","036121700116","FL4050","FL4050","1","FL SHOCK OIL 5WT--.--16OZ GET 2","","0","Bicycle Technologies International","O","","","","","","","","","8.95","19.99","","","","42063","","42063.7094444444---...---FLS17361201Z","42063.7094444444","","","","FINISH LINE","Accessories - Maintenance - Suspension Fluid","","42277.6552893519","","","","","","","","","","","","","","","","",""
"","SPE298655664","719676126357","542-3700","542-3700","1","SPEC FLATBOY GLUELESS PATCHKIT '14""","8","18","Specialized Bicycle Components","","","","","","","","","","1.44","2.99","","","","42063","","42063.7109722222---...---SPE298655664","42063.7109722222","","","","Specialized","Accessories - Flat Repair and Prevention - Patch Kits - Glueless","","42277.6569791666","","","","","","","","","","","","","","","","",""
A4:BB4
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
A5:BB5
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
A4:BB5
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1
1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54
54,53,52,51,50,49,48,47,46,45,44,43,42,41,40,39,38,37,36,35,34,33,32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12,11,10,9,8,7,6,5,4,3,2,1

Upvotes: 0

PatricK

Reputation: 6433

Try this one, but this only output the last row of data within the list.

Private Function Range2CSV(list) As String
    Dim sLine As String, sVal As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
        cr = 0 ' Current Row
        For Each r In list.Cells
            ' Check row changes
            If r.Row <> cr Then
                sLine = ""
                cr = r.Row
            End If
            If r.Row = cr Then
                ' Store cell value
                If IsEmpty(r) Then
                    sVal = """""" ' "" in the string output
                Else
                    sVal = r.Value
                End If
                ' Set or Join the values together
                If Len(sLine) = 0 Then
                    sLine = sVal
                Else
                    sLine = sLine & "," & sVal
                End If
            End If
        Next
    End If

    Range2CSV = sLine
End Function

Upvotes: 0

A.S.H

Reputation: 29332

To deal with the problem of blank first cell, you can add the indicated line below to your code (tested). Eventually, this answer does not address other issues if any.

Private Function Range2CSV(list) As String
    Dim tmp As String
    Dim cr As Long
    Dim r As Range

    If TypeName(list) = "Range" Then
        cr = 1
        For Each r In list.Cells
            If r.Row = cr Then
                If tmp = vbNullString Then
                     tmp = r.Value
                     If tmp = vbNullString Then tmp = ","  ' <~~~~ add this line
                Else
                    tmp = tmp & "," & r.Value
                End If
            Else
                cr = cr + 1
                tmp = r.Value
            End If
        Next
    End If
    Range2CSV = tmp
End Function

Upvotes: 0

Appending rows to a .csv file is somehow missing the first two columns of data

Answers (6)

Related Questions