Export range with data to single CSV file

Question

What is an efficient way to export a particular range of cells with data from Excel 2010 to CSV using VBA? The data always starts at cell A3. The end of the range depends on the dataset (always column Q but row end may vary). It should only export data from sheet 2 called 'Content' and the cells need to contain only 'real' data like text or numbers, not empty values with formulas.

The reason cells have formulas is because they reference cells from sheet 1 and 3. Formulas use normal reference and also vertical searches.

Using the UsedRange will export all the cells which are used by Excel. This works, but it also ends up exporting all the empty cells containing formulas but no data leading to lots (510 to be precise) of unnecessary semicolons in the output .csv.

Sub SavetoCSV()
    Dim Fname As String
 Sheets("Content").UsedRange.Select
 Selection.Copy
 Fname = "C:\Test\test.csv"
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:=Fname, _
    FileFormat:=xlCSV, CreateBackup:=False, local:=True
    Application.DisplayAlerts = False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

One solution might be to change the UsedRange in the VB code with Offset or Resize. Another might be to create a RealRange variable and then selectcopy that.

Similar kind of questions have been asked more than once, like here, here and here, and I've also looked at SpecialCells, but somehow I cannot get it to work the way I want it to.

I have tried the below code, but it ends up adding rows from sheet 3 as well.

 Sub ExportToCSV()
 Dim Fname As String
 Dim RealRange As String
 Dim Startrow As Integer
 Dim Lastrow As Integer
 Dim RowNr As Integer

 Startrow = 3
 RowNr = Worksheets("Content").Cells(1, 1).Value 'this cells has a MAX function returning highest row nr
 Lastrow = RowNr + 3
 RealRange = "A" & Startrow & ":" & "Q" & Lastrow

 Sheets("Content").Range(RealRange).Select
 Selection.Copy
 Fname = "C:\Test\test.csv"
    Workbooks.Add
    ActiveSheet.Paste
    ActiveWorkbook.SaveAs Filename:=Fname, _
    FileFormat:=xlCSV, CreateBackup:=False, local:=True
    Application.DisplayAlerts = False
    'ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

If I'm looking in the wrong direction, please refer to other options.

Answer 1

If I understand, you only want to export the cell if it has a value in it. This is going to lead to a csv with different numbers of columns in it. If that's truly what you are trying to do then the fastest way I think is writing your results to a file as below. This ran in about 1 second for 20,000 rows

Dim Lastrow As Integer
Dim RowNr As Integer
Dim SourceSheet As Worksheet
Const Fname As String = "C:\Test\test.csv"
Const StartRow As Integer = 3
Sub ExportToCSV()
On Error GoTo errorhandler
Set SourceSheet = Worksheets("Content")
    TargetFileNumber = FreeFile()
    Open Fname For Output As #TargetFileNumber 'create the file for writing
    Lastrow = SourceSheet.Cells(1, 1).Value + 3 'I would just use the used range to count the rows but whatever
    For r = StartRow To Lastrow 'set up two loops to go through the rows column by column
        Line = ""
        If SourceSheet.Cells(r, 1).Value <> "" Then 'check if there is a value in the cell, if so export whole row
            For c = 1 To 17 'Columns A through Q                
                Line = Line & SourceSheet.Cells(r, c).Value & "," 'build the line                
            Next c
        Line = Left(Line, Len(Line) - 1) 'strip off last comma
        Print #TargetFileNumber, Line 'write the line to the file
    End If
    Next r
 GoTo cleanup
errorhandler:
MsgBox Err.Number & " --> " & Err.Description, vbCritical, "There was a problem!"
cleanup:
Close #TargetFileNumber
End Sub