Exporting to text file in multiple lines

[Dani]

I have an excel spreadsheet with data set up in four different columns.
Sample data below:

Start 42, 43 56, 56 Finish
Start 12, 34 45, 45 Finish
Start 45, 56 78, 34 Finish
Start 45, 45 42, 43 Finish
Start 78, 34 12, 34 Finish
Start 45, 67 96, 23 Finish
Start 96, 23 45, 56 Finish
Start 56, 56 45, 45 Finish
Start 78, 34 78, 34 Finish
Start 12, 34 45, 56 Finish

I need to export those four columns of data to a text file, but need it to
end up in the the following format, with each cell on the next line:

Start
42, 43
56, 56
Finish
Start
12, 34
45, 45
Finish
Start
45, 56
78, 34
Finish

I'm currently using column Q-T on a sheet named "Data". Each week there is a
different number of rows, so I just need all rows containing data to be
addressed. Can anyone help? Thanks!

Dani

 

[Mike H]

Dani,

Try this. The purpose of this line

If Dir(targetfile) <> "" Then Kill targetfile

is to delete your text file if it already exists

Sub Marine()
Dim LastRow As Long
Set sht = Sheets("Data")
saveDir = "C:\" 'Change to suit
targetfile = saveDir & "MyFile.txt" 'Change to suit
LastRow = sht.Cells(Cells.Rows.Count, "Q").End(xlUp).Row
If Dir(targetfile) <> "" Then Kill targetfile
Open targetfile For Output As #1
Set MyRange = sht.Range("Q1:Q" & LastRow)
For Each c In MyRange
Print #1, c.Value
For x = 1 To 3
Print #1, c.Offset(, x).Value
Next
Next
Close #1
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Dani]

Works perfectly! Thanks, Mike!

Dani,

Try this. The purpose of this line

If Dir(targetfile) <> "" Then Kill targetfile

is to delete your text file if it already exists

Sub Marine()
Dim LastRow As Long
Set sht = Sheets("Data")
saveDir = "C:\" 'Change to suit
targetfile = saveDir & "MyFile.txt" 'Change to suit
LastRow = sht.Cells(Cells.Rows.Count, "Q").End(xlUp).Row
If Dir(targetfile) <> "" Then Kill targetfile
Open targetfile For Output As #1
Set MyRange = sht.Range("Q1:Q" & LastRow)
For Each c In MyRange
Print #1, c.Value
For x = 1 To 3
Print #1, c.Offset(, x).Value
Next
Next
Close #1
End Sub

--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Mike H]

Your welcome and thanks for the feedback
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.