Exporting non contigous ranges

[ozibryan]

I need to be able to send different data to diffeent groups. I have tried to
use ranges to do this. e.g.

I define a range, as folows ; ("ColFocus")

=Sheet1!$A$1:$A$17,Sheet1!$I$1:$I$17,Sheet1!$H$1:$H$17,Sheet1!$E$1:$E$17

This example always returns by Col:

************************************* by Col ***************

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean)

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

Application.ScreenUpdating = False
On Error GoTo EndMacro:

FNum = FreeFile

Open FName For Output Access Write As #FNum

Set t = Range("ColFocus")
MaxRow = t.Rows.Count
MaxCols = t.Columns.Count

For Each r In Range("ColFocus")
CellValue = r.Value
WholeLine = WholeLine & CellValue & Sep
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine; Sep
CellValue = " "
CellValue = "row " & r.Row & " Col " & r.Column
WholeLine = WholeLine & CellValue & Sep
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine; Sep
Next r

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub

************************************ end by Col *************

How can I make this return a result "byrows" - what I need is a CSV file of
records -reflecting the selected columns.

Anu help gratefully appreciated, I could 'hardcide' a series of values but
if I could use excel to select the desired format it could save a lot of
work.

 

[Tom Ogilvy]

Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean)

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 Range
Dim r As Range, t As Range

Application.ScreenUpdating = False
On Error GoTo EndMacro:

FNum = FreeFile

Open FName For Output Access Write As #FNum
Set t = Range("ColFocus")
For Each r In Range("ColFocus").Areas(1).Rows
Set r1 = Intersect(r.EntireRow, t.EntireColumn)
WholeLine = ""
For Each CellValue In r1
WholeLine = WholeLine & CellValue & Sep
Next CellValue
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine
Next r

EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum

End Sub