Is there a way to write ranges in bulk to a text/CSV file?

Question

I'm used to write the content (values) of a range of cells to a text file with the write command in VBA, for example:

write #myfile, Range("A1").value, Range("A2).value, Range("A3).value

Does there exist a more elegant and convenient built-in method to dump a whole range directly to a delimited file, possibly even over multiple rows at a time? Or has anybody come up with a customized solution? I think that would be incredibly useful.

Solution 1

I wrote you this it could still be improved, but I think it's good enough:

Sub SaveRangeAsCSV(r As Range, filename As String, overwrite As Boolean)
    Dim wB As Workbook
    Dim c As Range
    Dim usedRows As Long
    If overwrite Then
        If Dir(filename) <> "" Then Kill filename
        If Err.Number <> 0 Then
            MsgBox "Could not delete previously existing file." & vbNewLine & Err.Number & ": " & Err.Description
            Exit Sub
        End If
    End If
    If Dir(filename) <> "" Then
        Set wB = Workbooks.Open(filename)
    Else
        Set wB = Workbooks.Add
    End If

    With wB.Sheets(1)
        usedRows = .UsedRange.Rows.Count
        'Check if more than 1 row is in the used range.
        If usedRows = 1 Then
            'Since there's only 1 row, see if there's more than 1 cell.
            If .UsedRange.Cells.Count = 1 Then
                'Since there's only 1 cell, check the contents
                If .Cells(1, 1) = "" Then
                      'you're dealing with a blank workbook
                      usedRows = 0
                End If
            End If
        End If
        'Check if range is contigious
        If InStr(r.Address, ",") Then
            For Each c In r.Cells
                .Range(c.Address).Offset(usedRows, 0).Value = c.Value
            Next
        Else
            .Range(r.Address).Offset(usedRows, 0).Value = r.Value
        End If
    End With
    wB.SaveAs filename, xlCSV, , , , False
    wB.Saved = True
    wB.Close
End Sub
Sub Example()
    'I used Selection here just to make it easier to test.
    'Substitute your actual range, and actual desired filepath
    'If you pass false for overwrite, it assumes you want to append
    'It will give you a pop-up asking if you want to overwrite, which I could avoid
    'by copying the worksheet and then closing and deleting the file etc... but I
    'already spent enough time on this one.
    SaveRangeAsCSV Selection, "C:\proofOfConcept.csv", False
End Sub

When using it, just supply the actual range, the actual filename, and whether or not you want to overwrite the file. :) This has been updated to allow non-contiguous ranges. For merged cells it will end up putting the value in the first cell of the merged range.

Solution 2

This is the solution I came up with by myself and suits my needs best as far as I can see:

Sub DumpRangeToTextFile(filehandle As Integer, source As Range)
Dim row_range As Range, mycell As Range
For Each row_range In source.rows
    For Each mycell In row_range.cells
        Write #filehandle, mycell.Value;
    Next mycell
    Write #filehandle,
Next row_range
End Sub

Short and sweet! ;)

Still I'm giving Daniel Cook's solution which is also very useful the credit it deserves.

Solution 3

These methods above iterate across the cell ranges in order to export the data. Anything that tends to do with looping over a range of cells in the sheet is extremely slow due to all the error checking.

Here's a way I did it without the iteration. Basically, it makes use of the built in function "Join()" to do the heavy lifting which would be your iteration loop. This is much faster.

The related Read() subroutine I detailed in another posting: https://stackoverflow.com/a/35688988/2800701

This is the Write() subroutine (note: this assumes your text is pre-formatted to the correct specification in the worksheet before you export it; it will only work on a single column...not on multiple column ranges):

Public Sub WriteRangeAsPlainText(ExportRange As Range, Optional textfilename As Variant)
   If IsMissing(textfilename) Then textfilename = Application.GetSaveAsFilename(FileFilter:="Text Files (*.txt), *.txt")
   If textfilename = "" Then Exit Sub

   Dim filenumber As Integer
   filenumber = FreeFile
   Open textfilename For Output As filenumber

   Dim textlines() As Variant, outputvar As Variant

   textlines = Application.Transpose(ExportRange.Value)
   outputvar = Join(textlines, vbCrLf)
   Print #filenumber, outputvar
   Close filenumber
End Sub