Maybe an easy If / Then statement? But I can't figure it out. Help!

[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

 

[Dave Peterson]

Maybe something like:

Option Explicit
Sub QCD()
' Dim all variables.
Dim DestFile As String
Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
Dim SecondLine As String

' 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
Close #FileNum
MsgBox "Cannot open filename " & DestFile
Exit Sub
End If

' Turn on error Handling
On Error GoTo 0

If Application.CountIf(Selection, "*@^*") > 0 Then
SecondLine = ""
Else
SecondLine = "Codeit"
End If


' 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,
If RowCount = 1 Then
Print #FileNum, SecondLine
End If
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

And something you didn't ask for:

You may want to look at using isdate(). It's a better check for dates than
looking for slashes.

And instead of making the user type the name of the output file, take a look at
the help for:
Application.GetSaveAsFilename

Kind of like this:

Option Explicit
Sub QCD()
' Dim all variables.
Dim DestFile As Variant

Dim FileNum As Integer
Dim ColumnCount As Integer
Dim RowCount As Integer
Dim SecondLine As String

Dim resp As Long

' Prompt for destination file
DestFile = Application.GetSaveAsFilename _
(InitialFileName:=CurDir & Application.PathSeparator _
& "Output.txt", filefilter:="Text files, *.txt", _
Title:="Destination Filename")
If DestFile = False Then
Exit Sub
End If

If Dir(DestFile) = "" Then
'do nothing
Else
resp = MsgBox(prompt:="that file exists--overwrite?", Buttons:=vbOKCancel)
If resp = vbCancel Then
Exit Sub
End If
End If

' 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
Close #FileNum
MsgBox "Cannot open filename " & DestFile
Exit Sub
End If

' Turn on error Handling
On Error GoTo 0

If Application.CountIf(Selection, "*@^*") > 0 Then
SecondLine = ""
Else
SecondLine = "Codeit"
End If


' 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,
If RowCount = 1 Then
Print #FileNum, SecondLine
End If
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

 

[surplusbc]

Amazing. Thanks so much. This forum has helped me beyond imagination.
Thanks again