Export range with data to single CSV file - vba

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