S
surplusbc
Hi All,
I have a macro listed below. You populate your excel spreadsheet,
highlight an area, and run the macro. The macro takes the area and
creates a txt file where you designate it to. The file encases each
cell value between quotes and separates the cells by a comma. If the
value is a date, it needs no quotes. What I need is to somehow program
it so that if it runs off finding '@^'. If within the selected area, it
finds '@^'. The second line in the txt file, or the first line after
the header row needs to be blank.
If, however, the selected area has no '@^', then the second line, the
row after the header and before the first record, needs to simply say
"CodeIt".
Does this make sense? Any ideas?
Sub QCD()
' Dim all variables.
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
' Prompt for destination file
DestFile = Application.InputBox( _
Prompt:="Enter the destination filename" & _
vbNewLine & "(with complete path):", _
Title:="Quote-Comma Exporter", _
Default:=CurDir & Application.PathSeparator, _
Type:=2)
' Get file handle number.
FileNum = FreeFile()
'Turn off error handling
On Error Resume Next
'Open Output File
Open DestFile For Output As #FileNum
'If err - report and end
If Err <> 0 Then
MsgBox "Cannot open filename " & DestFile
End
End If
' Turn on error Handling
On Error GoTo 0
' Loop for each row
For RowCount = 1 To Selection.Rows.Count
' Look for each column
For ColumnCount = 1 To Selection.Columns.Count
' Date Validation
If InStr(Selection.Cells(RowCount, ColumnCount).Text, "/") > 0 Then
' Write cell text to file
Print #FileNum, Selection.Cells(RowCount, _
ColumnCount).Text;
Else
' Write cell text to file with " marks
Print #FileNum, """" & Selection.Cells(RowCount, _
ColumnCount).Text & """";
End If
' Is last column?
If ColumnCount = Selection.Columns.Count Then
' then write a blank line.
Print #FileNum,
Else
' Else write a comma.
Print #FileNum, ",";
End If
' Next column loop...
Next ColumnCount
' Next row loop...
Next RowCount
' Close output file and end
Close #FileNum
End Sub
I have a macro listed below. You populate your excel spreadsheet,
highlight an area, and run the macro. The macro takes the area and
creates a txt file where you designate it to. The file encases each
cell value between quotes and separates the cells by a comma. If the
value is a date, it needs no quotes. What I need is to somehow program
it so that if it runs off finding '@^'. If within the selected area, it
finds '@^'. The second line in the txt file, or the first line after
the header row needs to be blank.
If, however, the selected area has no '@^', then the second line, the
row after the header and before the first record, needs to simply say
"CodeIt".
Does this make sense? Any ideas?
Sub QCD()
' Dim all variables.
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
' Prompt for destination file
DestFile = Application.InputBox( _
Prompt:="Enter the destination filename" & _
vbNewLine & "(with complete path):", _
Title:="Quote-Comma Exporter", _
Default:=CurDir & Application.PathSeparator, _
Type:=2)
' Get file handle number.
FileNum = FreeFile()
'Turn off error handling
On Error Resume Next
'Open Output File
Open DestFile For Output As #FileNum
'If err - report and end
If Err <> 0 Then
MsgBox "Cannot open filename " & DestFile
End
End If
' Turn on error Handling
On Error GoTo 0
' Loop for each row
For RowCount = 1 To Selection.Rows.Count
' Look for each column
For ColumnCount = 1 To Selection.Columns.Count
' Date Validation
If InStr(Selection.Cells(RowCount, ColumnCount).Text, "/") > 0 Then
' Write cell text to file
Print #FileNum, Selection.Cells(RowCount, _
ColumnCount).Text;
Else
' Write cell text to file with " marks
Print #FileNum, """" & Selection.Cells(RowCount, _
ColumnCount).Text & """";
End If
' Is last column?
If ColumnCount = Selection.Columns.Count Then
' then write a blank line.
Print #FileNum,
Else
' Else write a comma.
Print #FileNum, ",";
End If
' Next column loop...
Next ColumnCount
' Next row loop...
Next RowCount
' Close output file and end
Close #FileNum
End Sub