I receive an error - Export-CSV-from-Excel-and-exclude-rows-based-on-cell-value

I had this question after viewing Export CSV from Excel and exclude rows based on cell value.

Hi Glen, the code you provided is basically what I need but when I copy and paste (few changes) then I receive an error.

"Run-Time Error '1004':
Application defined or object defined Error"

Some facts
1. I have a workbook with lots of sheets the one to export to .csv is called MDA,
2. Don't need the prompt so it is commented out (perhaps to use in future),
3. Prefer to use the MDA sheet "UsedRange" as the selection
4. Column I is the same purpose as in your script dblTestValue "when zero next row"

Option Explicit

Sub CreateAndExportCSVFile()

Dim fName As String
Dim fs As Long
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") & ActiveWorkbook.Sheets("DATA").Range("C11") & ".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
    
    ActiveWorkbook.Sheets("MDA").UsedRange
    
    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
    ActiveWorkbook.Sheets("MDA").Range("A1").Select
'Else
'    Exit Sub
'End If

End Sub

Open in new window



Thanks
Aracnid

<<VBScript removed as a tag from this question. This is a VBA question. byundt--MIcrosoft Excel Zone Advisor>>
Aracnid WebbAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
The posted code likely had a run-time error on statement 46 because no cells were selected in statement 44. Furthermore, the code looped through the used range of the MDA worksheet using worksheet row and column numbers--which would be correct only if the used range started in cell A1. Finally, the code tested a column index of 9 for a number--but that would be column I only if the used range started in column A.

The following code fixes those problems and is working in my test workbook.
Sub CreateAndExportCSVFile()

Dim fName As String
Dim fs As Long
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
Dim ColI As Integer
Dim rg As Range

'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") & ActiveWorkbook.Sheets("DATA").Range("C11") & ".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
    
    Set rg = ActiveWorkbook.Sheets("MDA").UsedRange
    With rg
        StartRow = 1
        StartCol = 1
        EndRow = .Rows.Count
        EndCol = .Columns.Count
        ColI = Columns("I").Column - rg.Column + 1
    End With
    
    Open fName For Output Access Write As #FNum
    
    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If rg.Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = ""
            Else
                CellValue = rg.Cells(RowNdx, ColNdx).Text
            End If
            WholeLine = WholeLine & CellValue & Sep
            'NEW: Assign intTestValue if on column I
            If ColNdx = ColI Then dblTestValue = rg.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
    Application.Goto ActiveWorkbook.Sheets("MDA").Range("A1")
'Else
'    Exit Sub
'End If

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Aracnid WebbAuthor Commented:
Thank you this works grate,

The file starts at A1 to N2400

Just a followup question, although column I is Rand values that are tested and the format is with two decimals 0.00 is there a way that I can change it so if it picks up text in thr I field it ignores the row similar to if it was 0 (so it doesn not get posted)?
0
byundtMechanical EngineerCommented:
I modified the code so it would ignore rows with text values in column I. The code will still stop the macro (go to statement EndMacro) if the column I cell contains an error value.

Note that the test for a numeric value on column I looks at the actual  value of the cell rather than the displayed text. So if you display only two decimal places and the RAND() function returns 0.00352 (displayed as "0.00"), the code recognizes that cell as a non-zero value and includes that line in the resulting CSV file. if you want to ignore that row, then use the commented out line in the IfElse block: dblTestValue = Val(rg.Cells(RowNdx, ColNdx).Text) instead of the one preceding it.
Sub CreateAndExportCSVFile()

Dim fName As String
Dim fs As Long
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
Dim ColI As Integer
Dim rg As Range

'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") & ActiveWorkbook.Sheets("DATA").Range("C11") & ".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
    
    Set rg = ActiveWorkbook.Sheets("MDA").UsedRange
    With rg
        StartRow = 1
        StartCol = 1
        EndRow = .Rows.Count
        EndCol = .Columns.Count
        ColI = Columns("I").Column - rg.Column + 1
    End With
    
    Open fName For Output Access Write As #FNum
    
    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If rg.Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = ""
            Else
                CellValue = rg.Cells(RowNdx, ColNdx).Text
            End If
            WholeLine = WholeLine & CellValue & Sep
            'NEW: Assign intTestValue if on column I
            If ColNdx = ColI Then
                dblTestValue = 0
                If Application.IsText(rg.Cells(RowNdx, ColNdx).Value) Then
                    dblTestValue = 0
                ElseIf IsNumeric(rg.Cells(RowNdx, ColNdx).Value) Then
                    dblTestValue = rg.Cells(RowNdx, ColNdx).Value
                    'dblTestValue = Val(rg.Cells(RowNdx, ColNdx).Text)  'Ignore row if column I is numeric and non-zero, but displayed as zero due to formatting
                End If
            End If
        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
    Close #FNum
    Application.Goto ActiveWorkbook.Sheets("MDA").Range("A1")

End Sub

Open in new window

0
Aracnid WebbAuthor Commented:
Excellent, thank you very much.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.