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

jeremypyle

Board Regular
Joined
May 30, 2011
Messages
174
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 :-D
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Why don't you delete all the unnecessary rows before exporting them as a CSV file? There might be more quick and nice ways.

VBA Code:
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
 
Upvote 0
Thanks so much Colo, this works fantastic! Sorry about the slow reply. I was off work for a while! Really appreciate your help :-D
 
Upvote 0
No worries about your reply. Good to hear it works!
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top