We help IT Professionals succeed at work.

Export CSV from Excel and exclude rows based on cell value

jackadmin
jackadmin asked
on
I have the following code in an Excel workbook that works perfectly to export values from a sheet into a CSV file.  I now need to modify this.

All I need to do is to check every row in my range selection to see if the value in column I is equal to numeric 0.  If I=0, then omit it from the CSV file and continue to the next row.

Can someone help me out with this?
Sub CreateAndExportCSVFile()

Dim fName As String
Dim fs
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim Sep As String
Dim Reply As Integer

Reply = MsgBox(Prompt:="Are you sure you are ready to create the payroll CSV file?", Buttons:=vbYesNo, Title:="Create Payroll CSV Confirmation")
If Reply = vbYes Then

    Application.ScreenUpdating = False
    
    On Error GoTo EndMacro:
    
    FNum = FreeFile
    
    Sep = ","
    
    fName = ThisWorkbook.Path & "\" & ActiveSheet.Range("A1") & "_ultipro_wk_" & Format(Now, "dd-mmm-yyyy") & ".csv"
    
    'Determine if the same CSV file aready exists 'If it does, DELETE it and create a new one from 'scratch Set fs = CreateObject("Scripting.FileSystemObject")
    'If fs.FileExists(fname) Then
    'Kill fname
    'End If
       If FileExists(fName) Then
           Set fs = CreateObject("Scripting.FileSystemObject")
           fs.DeleteFile (fName)
       End If
    
    Range("A1:I199").Select
    
    With Selection
    StartRow = .Cells(1).Row
    StartCol = .Cells(1).Column
    EndRow = .Cells(.Cells.Count).Row
    EndCol = .Cells(.Cells.Count).Column
    End With
    
    Open fName For Output Access Write As #FNum
    
    For RowNdx = StartRow To EndRow
    WholeLine = ""
    For ColNdx = StartCol To EndCol
    
    If Cells(RowNdx, ColNdx).Value = "" Then
    CellValue = ""
    Else
    CellValue = _
    Application.WorksheetFunction.Text _
    (Cells(RowNdx, ColNdx).Value, _
    Cells(RowNdx, ColNdx).NumberFormat)
    End If
    WholeLine = WholeLine & CellValue & Sep
    Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    Print #FNum, WholeLine
    Next RowNdx
    
EndMacro:
    On Error GoTo 0
    
    Application.ScreenUpdating = True
    
    Close #FNum
    
    Range("A1").Select


Else
    Exit Sub
End If

End Sub

Open in new window

Comment
Watch Question

View Solution Only

Excel VBA Developer
CERTIFIED EXPERT
Top Expert 2014
Commented:
Even though your selection range currently runs through column I, I added code that would work regardless of the number of columns in your selection.  It will assign a new variable, intTestValue, to the value in column I.  Then it will test if the value of intTestValue is non-zero; if so, it executes the Print command.

I didn't know what kind of values might appear in column I, so I declared the variable as Double, but it could be Integer or Long, depending on what you typically see.

-Glenn


Option Explicit

Sub CreateAndExportCSVFile()

Dim fName As String
Dim fs
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Dim Sep As String
Dim Reply As Integer
'New variable
Dim dblTestValue As Double

Reply = MsgBox(Prompt:="Are you sure you are ready to create the payroll CSV file?", Buttons:=vbYesNo, Title:="Create Payroll CSV Confirmation")
If Reply = vbYes Then

    Application.ScreenUpdating = False
    
    On Error GoTo EndMacro:
    
    FNum = FreeFile
    
    Sep = ","
    
    fName = ThisWorkbook.Path & "\" & ActiveSheet.Range("A1") & "_ultipro_wk_" & Format(Now, "dd-mmm-yyyy") & ".csv"
    
    'Determine if the same CSV file aready exists 'If it does, DELETE it and create a new one from 'scratch Set fs = CreateObject("Scripting.FileSystemObject")
    'If fs.FileExists(fname) Then
    'Kill fname
    'End If
       If FileExists(fName) Then
           Set fs = CreateObject("Scripting.FileSystemObject")
           fs.DeleteFile (fName)
       End If
    
    Range("A1:I199").Select
    
    With Selection
        StartRow = .Cells(1).Row
        StartCol = .Cells(1).Column
        EndRow = .Cells(.Cells.Count).Row
        EndCol = .Cells(.Cells.Count).Column
    End With
    
    Open fName For Output Access Write As #FNum
    
    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = ""
            Else
                CellValue = _
                Application.WorksheetFunction.Text _
                (Cells(RowNdx, ColNdx).Value, _
                Cells(RowNdx, ColNdx).NumberFormat)
            End If
            WholeLine = WholeLine & CellValue & Sep
            'NEW: Assign intTestValue if on column I
            If ColNdx = 9 Then dblTestValue = Cells(RowNdx, ColNdx).Value
        Next ColNdx
    WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
    'NEW: Test for zero in column I result. If not zero, then print.
    If dblTestValue <> 0 Then
        Print #FNum, WholeLine
    End If
    
    Next RowNdx
    
EndMacro:
    On Error GoTo 0 
    Application.ScreenUpdating = True
    Close #FNum
    Range("A1").Select
Else
    Exit Sub
End If

End Sub

Open in new window

jackadmin

Author

Commented:
That was exactly what I needed.  Worked great.