I receive an error - Export-CSV-from-Excel-and-
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"
Thanks
Aracnid
<<VBScript removed as a tag from this question. This is a VBA question. byundt--MIcrosoft Excel Zone Advisor>>
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>>
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)?
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)?
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.
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
Gain unlimited access to on-demand training courses with an Experts Exchange subscription.
Get AccessWhy Experts Exchange?
Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.
Jim Murphy
Programmer at Smart IT Solutions
When asked, what has been your best career decision?
Deciding to stick with EE.
Mohamed Asif
Technical Department Head
Being involved with EE helped me to grow personally and professionally.
Carl Webster
CTP, Sr Infrastructure Consultant
Did You Know?
We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE
Ask ANY Question
Connect with Certified Experts to gain insight and support on specific technology challenges including:
- Troubleshooting
- Research
- Professional Opinions