Save each row as txt, with some ects

[Whaletacos]

Hi everybody,

So I have been tinkering with getting excel to save each row as a txt file, without much luck.

The format is as follows,

Cells (1,1) contains the filename

The contents of the first .txt file then needs to be Cells(1,1;1,2)
The contents of the second .txt file needs to be Cells(2,1;2,2)
as so forth
Until it hits an empty cell.

The output path needs to be the current path of the workbook.


Any input will be much appriciated

- Whaletacos

 

[pike]

Hello,
something like,,,

Option Explicit
Sub DataExport()
    Dim CellItem As Range
    Open ThisWorkbook.Path & "\RawTest.txt" For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    For Each CellItem In Range("A8:M17", "A22:D207")' change range/cell to suit
        If Not CellItem.Locked And Not CellItem.Value = vbNullString Then
            Write [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , CellItem.Worksheet.Name, CellItem.Row, CellItem.Column, CellItem.Value
        End If
    Next
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
End Sub

Sub DataImport()
    Dim strWS As String
    Dim lngRow As Long
    Dim lngColumn As Long
    Dim CellValue
    Open ThisWorkbook.Path & "\RawTest.txt" For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Do While Not EOF(1)
        Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , strWS, lngRow, lngColumn, CellValue
        With Worksheets(strWS)
            .Cells(lngRow, lngColumn).Value = CellValue
        End With
    Loop
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
End Sub

 

[Whaletacos]

Hi Pike,

Thanks for the quick response!

Reading my thread again, I see it comes off rather unclear.

The data is in excel, and needs to be "Written" to a .txt
The field with "8000-01" is A1
[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]8000-01[/TD]
[TD]GGGTTTAAACCC[/TD]
[/TR]
[TR]
[TD]8000-02[/TD]
[TD]CCCAAAGGGTT[/TD]
[/TR]
[TR]
[TD]8000-03[/TD]
[TD]TTTAAGGGCC[/TD]
[/TR]
[TR]
[TD]8000-04[/TD]
[TD]AAAGGGTTTCCC[/TD]
[/TR]
</tbody>[/TABLE]

I'm trying to get excel to write a .txt file for each of these lines.

The name of the file, should be "8000-01"
The content should be "8000-01,GGGTTTAAACCC"

File two should be "8000-02,CCCAAAGGGTT" and so on.

All files should be written to the same folder as the workbook is in.
Example
"Y:\Currentset\Seqs\8000"

 

[pike]

Hello,
One way,,,

Option Explicit
Sub DataExport()
    Dim lngRow As Long
    For lngRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Open ThisWorkbook.path & "\" & Cells(lngRow, 1).Value & ".txt" For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        Write [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , Join(Application.Transpose(Application.Transpose(Range("A" & lngRow & ":B" & lngRow).Value)), ",")
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Next
End Sub

 

[Whaletacos]

Hi Pike!

Thank you so much, it worked wonders!

I adapted a few minor details, from write to print to avoid (") qoutation marks in the printed file.
And changed "Thisworkbook.path" to "activeworkbook.path" so I could throw it in the personal folder without it printing the file to XLSTART.
Thank you again!

The final code for good measure

Option ExplicitSub DataExport()
    Dim lngRow As Long
    For lngRow = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        Open ActiveWorkbook.Path & "\" & Cells(lngRow, 1).Value & ".txt" For Output As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
        Print [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , Join(Application.Transpose(Application.Transpose(Range("A" & lngRow & ":B" & lngRow).Value)), ",")
        Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Next
'Credits to pike from mrexcel.com
End Sub