Write out variable number of rows to text file

[Squabeggz]

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:

    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!

 

[bertie]

Hi, and welcome to the forum.

Have a read through this and see if it helps.

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]

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]

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.

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]

Solved!

It was a just matter of adding the following 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

 

[bertie]

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

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:

file_path = GetFolder("C:\", "Select an Output Folder") & "\"

Or within your function:

    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.

 

[Rick Rothstein]

Solved!

It was a just matter of adding the following 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.

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]

Thanks for taking the time to help, guys. All this good info will be put to use.