Write out variable number of rows to text file

Squabeggz

New Member
Joined
Jan 6, 2014
Messages
12
What I'm trying to do is write out text files based on groups of rows. Each text file is named after the value of a cell in column A and contains the values in column B. The groups are also seperated by the column A.

For example:
A
B
Filename1
text
text
text
Filename2
text2
text2
text2
text2

<tbody>
</tbody>

So "Filename1.txt" would contain the 3 rows of "text" and "Filename2.txt" would contain the 4 rows of "text2" etc...

I have pieced together some code from help and research around the web, but it only works when using a fixed number of rows.

Here is what I have:

Code:
    Sub export_multiple_line_files()
        'assumes current sheet needs outputting
        'assumes four lines per file -- filenames in column a; contents in column b

        file_path = "c:\"

        r = 1
        Do While Not IsEmpty(Range("a" & r))
            cur_file = Range("a" & r).Value & ".txt"
            Open file_path & "\" & cur_file For Output As #1
            For i = 0 To 3
                Print #1, Range("b" & r + i).Value
            Next i
            Close #1
            r = r + 4
        Loop
    End Sub


This works for fixed 4 line groups...I need it to work on varible number of rows.
Any help on this would be a huge time saver. Thanks!
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

bertie

Well-known Member
Joined
Jun 12, 2009
Messages
1,869
Hi, and welcome to the forum.

Have a read through this and see if it helps.

Rich (BB code):
Option Explicit


Sub export_multiple_line_files()
   'assumes current sheet needs outputting
   
   Dim file_path As String
   Dim cur_file As String
   Dim text_out As String
   Dim rng As Range
   Dim fNum As Long
   
   file_path = "c:\temp\"  'Bertie test folder


   'set range to loop through column B until it finds an empty cell
   Set rng = Range("B1")
   Do Until rng = ""
   
      'output to new file
      If cur_file = "" Then
      
         'set up the output file name
         cur_file = file_path & rng.Offset(, -1).Value & ".txt"
         
         'start to build the output string
         text_out = rng.Value
      Else
         'output to same file
         text_out = text_out & vbCrLf & rng.Value
      End If
       
      'do we need to write to file?
      'check next row column A for a value
      If rng.Offset(1, -1).Value <> "" Then
         'output
         OutputToTextFile cur_file, text_out
         
         'reset variables
         cur_file = ""
         text_out = ""
      End If
      
      'next row
      Set rng = rng.Offset(1, 0)
   Loop
   
   'output last file
   OutputToTextFile cur_file, text_out
   
   'tidy up
   Set rng = Nothing
End Sub


Private Sub OutputToTextFile(ByVal FileName As String, _
                             ByVal OutputText As String)
   Dim fNum As Long
   
   'working with multiple output files so use a variable for the next free file number
   fNum = FreeFile()
   
   Open FileName For Output As #fNum
   Print #fNum, OutputText
   Close #fNum
End Sub
 

Squabeggz

New Member
Joined
Jan 6, 2014
Messages
12
So far, this is exactly what I need. Thank you so much! Also, thanks for commenting your code. This really helps me (I'm not a coding wizard..at all) to get a much better understanding of what is going on and learn for future use. Much appreciated.

I'm going to keep testing this out. Cheers!
 

Squabeggz

New Member
Joined
Jan 6, 2014
Messages
12
I've got another request to add to this code. It seems like it should be fairly simple but I cannot figure it out. I'd like to be able to choose the output location and not have to edit the code everytime.

I've been messing around with adding something like this but cant quite get it to work. It works independantly, so i'm pretty sure I am just screwing it up when trying to add this to the above code.

Code:
Sub getFldNames()
    outputFolder = GetFolder("C:\", "Select an Output Folder")
End Sub
 
 
Function GetFolder(strPath As String, fldSt As String) As String
    Dim fldr As FileDialog
    Dim sItem As String
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = fldSt
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function
 

Squabeggz

New Member
Joined
Jan 6, 2014
Messages
12

ADVERTISEMENT

Solved!

It was a just matter of adding the following code:

Code:
Sub SelectFolder()
    Dim fd As FileDialog
    Dim sPath As String
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    If fd.Show = -1 Then
        sPath = fd.SelectedItems(1) & "\"
    End If
    
    'sPath now holds the path to the folder or nothing if the user clicked the cancel button
    MsgBox sPath
End Sub

and then changing file_path = "C:\" to file_path = sPath

Thanks to vaskov17 who posted the code in another thread...Search function actually works :p
 

bertie

Well-known Member
Joined
Jun 12, 2009
Messages
1,869
I think your problem is that you are missing the end backslash in the folder path.

Have a look at this line in my code in post #2
Rich (BB code):
file_path = "c:\temp\"  'Bertie test folder
NB Note the end baclslash.

You need to add this to the calling statement to your function.
Either in the calling procedure:
Rich (BB code):
file_path = GetFolder("C:\", "Select an Output Folder") & "\"

Or within your function:
Rich (BB code):
    GetFolder = sItem & "\"
End Function

Also
Using FileDialog requires a reference to Tools => Reference => Microsoft Object xx Library.

[edit]
Or as you said above. The dangers of answering the door whilst posting to a thread.
 
Last edited:

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,149
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
Solved!

It was a just matter of adding the following code:

Code:
Sub SelectFolder()
    Dim fd As FileDialog
    Dim sPath As String
    
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    If fd.Show = -1 Then
        sPath = fd.SelectedItems(1) & "\"
    End If
    
    'sPath now holds the path to the folder or nothing if the user clicked the cancel button
    MsgBox sPath
End Sub

and then changing file_path = "C:\" to file_path = sPath
I used your above posted code to get the path to save the output files to, but incorporated directly into it a much shorter routine to get the filenames and output its data to a file with that name (basically, a replacement for Bertie's routine)... I have highlighted my additions in red so you can find them easier.

Rich (BB code):
Sub SelectFolderAndOutputDataFilesToIt()


  Dim fd As FileDialog
  Dim sPath As String
  Dim LastRow As Long
  Dim FF As Long
  Dim Ar As Range
  
  Set fd = Application.FileDialog(msoFileDialogFolderPicker)
  
  If fd.Show = -1 Then
    sPath = fd.SelectedItems(1) & "\"
  End If
  
  On Error GoTo NoFileNames
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  For Each Ar In Range("A1:A" & LastRow).SpecialCells(xlBlanks).Areas
    FF = FreeFile
    Open sPath & Ar(1).Offset(-1) & ".txt" For Output As #FF
    Print #FF, Join(Application.Transpose(Ar(1).Offset(-1, 1).Resize(Ar.Count + 1)), vbNewLine)
    Close #FF
  Next
  
NoFileNames:
 
End Sub
 

Squabeggz

New Member
Joined
Jan 6, 2014
Messages
12
Thanks for taking the time to help, guys. All this good info will be put to use.
 

Forum statistics

Threads
1,136,354
Messages
5,675,303
Members
419,560
Latest member
g3org

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top