VBA to Save Row to text file, then move to next row and continue.

[VanderBoon]

Hi,

I have an excel file of which I need to export into multiple text files. I need to export columns B onwards into a text file (ignoring blank cells) and finish with 2 specific text strings, then save as the value in column A. It then needs to do the same for each row underneath (up to 500), saving a unique file each time.

Below is how the final text file should look, the last 2 lines are constant.

R000001.txt:

SCAN,Part Number,FINAL LABEL
COMPARE,Part Number ,PLBLTRNS.txt
COMPARE,partnumber1,PLBLTPK.txt
COMPARE,Partnumber2,PLBLTPK.txt
END,END,END,
END,,

I'm a complete novice at VBA and so far have managed to get a code to a point where it will create the file with one line but with a fixed name. I'm sure there's a simple solution to this, my current code is below:

Sub WriteToRecipes()

   Dim Path As String
   Dim filename As String
   Dim FileNumber As Integer
   Dim LC As Integer
   
   Dim i As Integer

    LC = Worksheets("Sheet4").Cells(1, Columns.Count).End(xlToLeft).Column + 1 'columns
    
    Path = "filepath\test.txt"
    FileNumber = FreeFile
    
    Open Path For Output As FileNumber
    
   '---------------------- Below code writes a recipe
   For i = 1 To LC
    
    If i <> LC Then
    
        Print #FileNumber, Cells(i); vbNewLine;
    Else
        Print #FileNumber, "END," & "END,"; "END,"
    End If
    
    Next i
    
    Print #FileNumber, "END,,";

   Close FileNumber
   
   '----------------------
 
   Shell "notepad.exe " & Path, vbNormalFocus
        
End Sub

Any help would be much appreciated!

Ewan

 

[GWteB]

Hi Vanderboon, Welcome to Mr.Exel.

If I understand correctly, the number of filled columns determines how many lines of text will eventually appear in the respective newly created text files. Is this correct?

 

[VanderBoon]

Hi GWteB,

Thanks for replying. That's correct, ignoring column A - that contains what I need the file to be called. They will range from 2-12 lines.

 

[GWteB]

Try the below. Bear in mind that the validity of the file names in column A is not checked.

Public Sub Vanderboon()

    Const OUTPUTPATH As String = "C:\Users\Vanderboon\Documents\"   ' <<< change folder to suit

    Dim FullFileName As String, FileNumber As Long
    Dim SrcFileNames As Range, arr As Variant
    Dim c As Range, i As Long

    With ThisWorkbook.Worksheets("Sheet4")           ' <<< change sheet name to suit

        Set SrcFileNames = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)

        For Each c In SrcFileNames

            arr = c.Resize(1, c.Cells(1, .Columns.Count).End(xlToLeft).Column)
            FullFileName = OUTPUTPATH & arr(1, 1) & ".txt"
            FileNumber = FreeFile
            Open FullFileName For Output As FileNumber

            For i = 2 To UBound(arr, 2)
                Print #FileNumber, arr(1, i)
            Next i
            Print #FileNumber, "END,END,END," & vbNewLine & "END,,"

            Close FileNumber
        Next c
    End With
End Sub

 

[VanderBoon]

That worked perfectly! Thanks a lot, I've spent days trying to figure it out!

 

[GWteB]

You are welcome and thanks for letting me know.