VBA to append data from worksheet to existing .csv file

[Dan5977]

Hi all,

I'm a little stuck. I have a spreadsheet which I am going to use to generate some values which then need to be appended to the first blank row in an existing .csv file.

This is what I have so far:

Sub Append2CSV()
Dim tmpCSV As String 'string to hold the CSV info
Dim f As Integer

Const CSVFile As String = "Y:\Robot\Jobs.csv"

f = FreeFile

Open CSVFile For Append As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f]#f[/URL] 
tmpCSV = Range2CSV(Range("A3:Q22"))
Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f]#f[/URL] , tmpCSV
Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f]#f[/URL] 
ActiveWorkbook.FollowHyperlink Address:=CSVFile
End Sub

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
Else
tmp = tmp & Chr(10) & r.Value
End If
End If
Next
End If

Range2CSV = tmp
End Function

1st problem
Whilst the data is within the range A3:Q22 it could be any number of rows long between 1 & 20.
So my script is currently adding blank rows in as it copies the entire range regardless of whether it has data in or not.

2nd problem
The first line of the import is going wrong. It is only importing cell A3. Cell B3:Q3 then imports on the second line. When I get to the next line it works correctly (importing cells A4:Q4).
Any help, as always, would be appreciated.

 

[John_w]

Try this - I rewrote Range2CSV to account for empty records and fields.

Sub Append2CSV()
    Dim tmpCSV As String 'string to hold the CSV info
    Dim f As Integer
    
    Const CSVFile As String = "Y:\Robot\Jobs.csv"
    
    f = FreeFile
    Open CSVFile For Append As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f]#f[/URL] 
    tmpCSV = Range2CSV(Range("A3:Q22"))
    Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f]#f[/URL] , tmpCSV
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=f]#f[/URL] 
    ActiveWorkbook.FollowHyperlink Address:=CSVFile
End Sub


Function Range2CSV(list As Range) As String
    
    Dim data As Variant
    Dim r As Long, c As Long
    Dim csvRecord As String, csvEmptyFields As String
    Dim csvAll As String
    
    csvAll = ""
    
    data = list.Value
    For r = 1 To UBound(data)
        csvEmptyFields = ""
        csvRecord = ""
        For c = 1 To UBound(data, 2)
            If Not IsEmpty(data(r, c)) Then
                csvRecord = csvRecord & csvEmptyFields & data(r, c) & ","
                csvEmptyFields = ""
            Else
                csvEmptyFields = csvEmptyFields & ","
            End If
        Next
        If csvRecord <> "" Then csvAll = csvAll & Left(csvRecord, Len(csvRecord) - 1) & vbLf
    Next

    Range2CSV = csvAll
    
End Function

 

[Dan5977]

Many thanks John.

That solves my 2nd problem but unfortunately not the 1st one.

I have filled in some dummy data on the master spreadsheet with 5 lines of data and 15 empty lines (all lines contain formulas). When I run the script it adds the 5 lines of data. If I run it again I get 16 blank rows before it adds it again.

 

[John_w]

I'm unable to reproduce the 1st problem. There was only 1 empty line in the output file between successive runs. This was caused by the trailing vbLf character which is removed in this updated function:

Function Range2CSV(list As Range) As String
    
    Dim data As Variant
    Dim r As Long, c As Long
    Dim csvRecord As String, csvEmptyFields As String
    Dim csvAll As String
    
    csvAll = ""
    
    data = list.Value
    For r = 1 To UBound(data)
        csvEmptyFields = ""
        csvRecord = ""
        For c = 1 To UBound(data, 2)
            If Not IsEmpty(data(r, c)) Then
                csvRecord = csvRecord & csvEmptyFields & data(r, c) & ","
                csvEmptyFields = ""
            Else
                csvEmptyFields = csvEmptyFields & ","
            End If
        Next
        If csvRecord <> "" Then csvAll = csvAll & Left(csvRecord, Len(csvRecord) - 1) & vbLf
    Next

    Range2CSV = Left(csvAll, Len(csvAll) - 1)
    
End Function

My test data has a number in column A and simple formulas across the columns, such as =A3+2, =B3+2, etc. What formulas do you have?

 

[Dan5977]

Your update has reduced my blank rows by one.

I have various formulas in the blank rows. Nested IF statements and VLOOKUPS. Many of them set to return "" if the vlookup finds a blank (I don't want zeros).

For example, in cell E3
=IF($C3="","",IF($C3="A",IF(VLOOKUP($D3,Data!$B$2:$O$15,2,0)="","",VLOOKUP($D3,Data!$B$2:$O$15,2,0)),IF($C3="B",IF(VLOOKUP($D3,Data!$B$16:$O$45,2,0)="","",VLOOKUP($D3,Data!$B$16:$O$45,2,0)))))

 

[John_w]

Update - I guessed you might have IF formulas which can return "". Therefore change:

           If Not IsEmpty(data(r, c)) Then

to:

           If Not IsEmpty(data(r, c)) And data(r, c) <> "" Then

 

[Dan5977]

John,

You are a genius. That works perfectly. Thanks very much for your help.

Have a virtual beer on me