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 ExplicitSub CreateAndExportCSVFile()Dim fName As StringDim fs As LongDim WholeLine As StringDim FNum As IntegerDim RowNdx As LongDim ColNdx As IntegerDim StartRow As LongDim EndRow As LongDim StartCol As IntegerDim EndCol As IntegerDim CellValue As StringDim Sep As StringDim Reply As Integer'New variableDim 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 RowNdxEndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #FNum ActiveWorkbook.Sheets("MDA").Range("A1").Select'Else' Exit Sub'End IfEnd Sub
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)?
byundt
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 StringDim fs As LongDim WholeLine As StringDim FNum As IntegerDim RowNdx As LongDim ColNdx As IntegerDim StartRow As LongDim EndRow As LongDim StartCol As IntegerDim EndCol As IntegerDim CellValue As StringDim Sep As StringDim Reply As Integer'New variableDim dblTestValue As DoubleDim ColI As IntegerDim 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 RowNdxEndMacro: On Error GoTo 0 Close #FNum Application.Goto ActiveWorkbook.Sheets("MDA").Range("A1")End Sub
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)?