CODEWITHSUNDEEP
excelvba
eke
eke

Reputation: 33

Write each Excel row to new .txt file with ColumnA as file name

I would be extremely grateful for any help as I have just begun to look into writing Excel macros.

I have excel documents with about 1,500 rows and variable column lengths, from 16-18. I would like to write each row of the file to a new .txt file (actually, I would REALLY like to write it as a .pdf but I don't think that's possible) where the name of the file is the corresponding first column. Additionally, I would like each row to be separated by a new line. So, ideally, the macro would 1) export each row as a new .txt file (or .pdf if possible), 2) name each file as ColumnA, 3) the content of each new .txt file would contain ColumnsB-length of total columns 4) each column is separated by a new line.

For example, if the document looks like this:

column 1//column 2// column3

a//a1//a2

b//b1//b2

I want it to output to be 2 files, named "a", "b". As an example, the contents of file "a" would be:

a1

a2

I have found 2 other stack overflow threads addressing separate pieces of my question, but I am at a loss as to how to stitch them together.

Each row to new .txt file, with a newline between each column (but file name not ColumnA): Create text Files from every row in an Excel spreadsheet

Only one column incorporated into file, but file names correspond with ColumnA: Outputting Excel rows to a series of text files

Thank you for any help!

Upvotes: 2

Views: 30919

Answers (4)

J. Dark
J. Dark

Reputation: 1

@danfo, I don't know if this will be useful to you, but after some fiddling, I did get this working. I needed to make sure that all my top row was written with no spaces or special characters; and my left column needed to be ID numbers, rather than dates or anything else -- but once I'd fixed those things, it worked fine.

Upvotes: 0

RAHMAD
RAHMAD

Reputation: 11

This should fix the problem of getting the same data in all the files:

Sub SaveRowsAsTXT()

Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long
Dim filePath As String
Dim fileName As String
Dim rowRange As Range
Dim cell As Range

filePath = "C:\Users\Administrator\Documents\TEST\"

For Each cell In Range("B1", Range("B10").End(xlUp))
    Set rowRange = Range(cell.Address, Range(cell.Address).End(xlToRight))

    Set wsSource = ThisWorkbook.Worksheets("Sheet1")

    Application.DisplayAlerts = False 'will overwrite existing files without asking

    r = 1
    Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
        ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
        Set wsTemp = ThisWorkbook.Worksheets(1)

        For c = 2 To 16
            wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
        Next c
        fileName = filePath & wsSource.Cells(r, 1).Value

        wsTemp.Move
        Set wbNew = ActiveWorkbook
        Set wsTemp = wbNew.Worksheets(1)

        wbNew.SaveAs fileName & ".txt", xlTextWindows 'save as .txt
        wbNew.Close
        ThisWorkbook.Activate
        r = r + 1
    Loop

    Application.DisplayAlerts = True

Next
End Sub

Upvotes: 1

eke
eke

Reputation: 33

I ended up stitching the following together to solve my problem, thanks entirely to @David and @Exactabox. It is incredibly inefficient and has redundant bits, but it runs (Very. Slowly). If anyone can spot how to clean it up, feel free, but otherwise it gets the job done.

[edit] Unfortunately I now realize that although this macro exports each row as an appropriately named new .txt file, the content of each text file is the last row of the document. So even if it exports all 20 lines as 20 .txt files with an appropriate file name and correct formatting, the actual content of each of the 20 files is the same. I am unsure how to rectify this.

Sub SaveRowsAsTXT()

Dim wb As Excel.Workbook, wbNew As Excel.Workbook
Dim wsSource As Excel.Worksheet, wsTemp As Excel.Worksheet
Dim r As Long, c As Long
Dim filePath As String
Dim fileName As String
Dim rowRange As Range
Dim cell As Range

filePath = "C:\filepath\"

For Each cell In Range("B1", Range("B1048576").End(xlUp))
   Set rowRange = Range(cell.Address, Range(cell.Address).End(xlToRight))

   fileName = filePath & cell.Offset(0, -1).Value

    Set wsSource = ThisWorkbook.Worksheets("Sheet1")

    Application.DisplayAlerts = False 'will overwrite existing files without asking

    r = 1
    Do Until Len(Trim(wsSource.Cells(r, 1).Value)) = 0
        ThisWorkbook.Worksheets.Add ThisWorkbook.Worksheets(1)
        Set wsTemp = ThisWorkbook.Worksheets(1)

        For c = 2 To 16
            wsTemp.Cells((c - 1) * 2 - 1, 1).Value = wsSource.Cells(r, c).Value
        Next c

        wsTemp.Move
        Set wbNew = ActiveWorkbook
        Set wsTemp = wbNew.Worksheets(1)
        wbNew.SaveAs fileName & ".txt", xlTextWindows 'save as .txt
        wbNew.Close
        ThisWorkbook.Activate
        r = r + 1
    Loop

    Application.DisplayAlerts = True

Next
End Sub

Upvotes: 1

David Zemens
David Zemens

Reputation: 53623

To get the contents to be columns B thru the end of the file, you could do something like this.

Create a simple loop over the cells in Column B. This defines a range of columns for each row, and also sets a filename based on the value in column A.

Sub LoopOverColumnB()

Dim filePath as String
Dim fileName as String
Dim rowRange as Range
Dim cell as Range

filePath = "C:\Test\" '<--- Modify this for your needs.

For each cell in Range("B1",Range("B1048576").End(xlUp))
   Set rowRange = Range(cell.address,Range(cell.address).End(xlToRight))

   fileName = filePath & cell.Offset(0,-1).Value

   '
   ' Insert code to write the text file here 
   '
   ' you will be able to use the variable "fileName" when exporting the file
Next
End Sub

Upvotes: 4

Related Questions