Forum Discussion

maxim545's avatar
maxim545
Copper Contributor
Aug 11, 2020

How to save each row of a spreadsheet as separate text files?

I have a spreadsheet with >4000 rows, where each row has 2 columns. I need separate txt files containing each report and hopefully each file under the name of the respective ID.

How can I do that? An example of the structure of the data:

ID (number)Report (text)
1645Today is a beautiful day... 
1967Today the sun is shinning

 

BI & Data Analysis
excel
Formulas and Functions
Macros and VBA

3 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Aug 11, 2020

    maxim545 

    Sub SaveAsTextFile()
    Dim strPath As String
    Dim lngID As Long
    Dim strReport As String
    Dim r As Long
    Dim m As Long
    ' Specify a different path if you wish
    strPath = ThisWorkbook.Path & Application.PathSeparator
    ' Last row
    m = Range("A" & Rows.Count).End(xlUp).Row
    ' Loop through the rows
    For r = 2 To m
        ' Get ID and Report
        lngID = Range("A" & r).Value
        strReport = Range("B" & r).Value
        ' Open text file
        Open strPath & lngID & ".txt" For Output As #1
        ' Write data
        Print #1, lngID; Tab; strReport
        ' Close the file
        Close #1
    Next r
End Sub
    • KIKEMAN78's avatar
      KIKEMAN78
      Copper Contributor
      Sep 27, 2021

      Hi Hans,

      I need a very similar routine, but I need to read the whole row, which may contain a different amount of cells. Can you help me?

      HansVogelaar 

      • bosinander's avatar
        bosinander
        Iron Contributor
        Sep 27, 2021

        KIKEMAN78 Assuming your version of Excel has the worksheet function TEXTJOIN, append the following into the macro from HansVogelaar 

         

        __/ before row 9, insert

        Columns("b:b").Insert 'add a temporary column for calculation
        Range(Range("b1"), "b" & Range("b1").SpecialCells(xlCellTypeLastCell).Row).Select 'select matching "last" row
        Selection.FormulaR1C1 = "=TEXTJOIN(CHAR(9),0,RC[1]:RC[16382])" 'join all texts but col A

         

        __/ before End Sub, insert
        Columns("b:b").Delete 'delete the temporary column

         

        Column B will temporarily join all cells to its right, including empty ones, to be exported as HansVogelaar code, and then deleted to reset the file.

        If you want to exclude empty cells, change the zero to one
        TEXTJOIN(CHAR(9),0, to TEXTJOIN(CHAR(9),1,

Resources