Macro to export to CSV but only export the lines with values. Ignore lines with formulas that have no values

[jeremypyle]

I have a macro that exports all sheets within the workbook to different csv files. The macro is:
Sub ExportSheetsToCSV()
Dim xWs As Worksheet
Dim xcsvFile As String
For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.Copy
xcsvFile = "C:\OneDrive\Houses\Business\Online ASB Payments\CSV" & "\aaa_import" & xWs.Name & ".csv"
Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
FileFormat:=xlCSV, CreateBackup:=False
Application.ActiveWorkbook.Saved = True
Application.ActiveWorkbook.Close
Next
End Sub

However it is also exporting the lines that have formulas but not visible data or values. Is there a way to edit this macro slightly so that it only exports the rows that have values but not import lines with no values?

Colin & Kathy Trust - 19 Jul 2022,19/07/2022,123106123456700, 10.00 ,CJ & KJ,Inv786-2020,1Clifford,061234567123400,Heatpump,ca99,1aCli,J- Z
Colin & Kathy Trust - 19 Jul 2022,19/07/2022,123106123456700, 15.00 ,CJ & KJ,,,061234567123400,Brian,ma99,,Brian & Trish Vesey wages
,,, ,,,,,,,,
,,, ,,,,,,,,
,,, ,,,,,,,,
,,, ,,,,,,,,
,,, ,,,,,,,,
,,, ,,,,,,,,



It is exporting rows 1 and 2 correctly. However lines 3 to 8 have formulas but no values. Is there a way to make this macro so that it doesn't export these rows with lots of commas?

Please note I still want to export blank cells if it is within a row that has values in other cells. However if there is an entire line with no values, I don't want these lines exported to csv

Would really appreciate anyones help with this

 

[Colo]

Why don't you delete all the unnecessary rows before exporting them as a CSV file? There might be more quick and nice ways.

Sub ExportSheetsToCSV()
    Dim sh As Worksheet, i As Long
    Dim xWs As Worksheet
    Dim xcsvFile As String
    For Each xWs In Application.ActiveWorkbook.Worksheets
        xWs.Copy
        Set sh = ActiveSheet   'copied one
        For i = GetLastRow(sh) To 1 Step -1
            If LineText(sh.Cells(i, 1)) = False Then
                'If no visible value is found, delete the entire row
                sh.Cells(i, 1).EntireRow.Delete
            End If
        Next
        xcsvFile = "C:\OneDrive\Houses\Business\Online ASB Payments\CSV" & "\aaa_import" & xWs.Name & ".csv"
        Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
                                          FileFormat:=xlCSV, CreateBackup:=False
        Application.ActiveWorkbook.Saved = True
        Application.ActiveWorkbook.Close
    Next
End Sub

Function LineText(ByVal Target As Range) As Boolean
'    If the Target row has any Values, this function returns True.
    Dim buf1D, buf2D
    'Get all the values from the target ROW as a 2D array
    buf2D = Target.Resize(, Columns.Count).Value
    'Make the 2D array a 1D array for using a JOIN function
    ReDim buf1D(LBound(buf2D, 2) To UBound(buf2D, 2))
    For i = LBound(buf1D) To UBound(buf1D)
        buf1D(i) = buf2D(1, i)
    Next
    If Join(buf1D, "") = "" Then
        LineText = False
    Else
        LineText = True
    End If
End Function

Function GetLastRow(ByVal sh As Worksheet)
'Get last row form all the columns
    Dim col As Long, i As Long
    Dim arr()
    Dim maxnum As Long: maxnum = -1
    col = 1
    ReDim arr(0 To Columns.Count - 1)
    Do
        arr(col - 1) = sh.Cells(Rows.Count, col).End(xlUp).Row
        col = col + 1
        If col > Columns.Count Then Exit Do
    Loop
    For i = 0 To UBound(arr)
        If arr(i) > maxnum Then
            maxnum = arr(i)
        End If
    Next i
    GetLastRow = maxnum
End Function

 

[jeremypyle]

Thanks so much Colo, this works fantastic! Sorry about the slow reply. I was off work for a while! Really appreciate your help

 

[Colo]

No worries about your reply. Good to hear it works!