troubleshooting Question

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

Avatar of Aracnid Webb
Aracnid Webb asked on
Microsoft OfficeMicrosoft ExcelVBA
4 Comments1 Solution105 ViewsLast Modified:
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


Thanks
Aracnid

<<VBScript removed as a tag from this question. This is a VBA question. byundt--MIcrosoft Excel Zone Advisor>>
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 1 Answer and 4 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 4 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros