I am new to VBA, I have been doing this manually. I need to automate in creating separate text files for each value in column A. I want the text files to be named with value of Column A, with columns B-F being the content of the text files,

For example: I have a master excel file with 20000 of rows (and 5 columns) with data something like below:

VendorCode | ItemCode | Price1 | Price2 | Price3 
033204     | svk3409  | 23.2   | 23.3   | 23.4
033204     | svk5619  | 24.2   | 24.3   | 24.4
033204     | cli7890  | 34.2   | 34.3   | 34.4
023272     | svk3413  | 18.9   | 18.2   | 18.3
023272     | svk4567  | 90.2   |90.3    | 90.4

I have the following code so far from references but it does not return all rows for the each vendor code. It returns only one row for each vendorcode.txt.

Sub SaveRangeToCsvFiles()
    Dim FileName As String
    Dim Ws As Worksheet
    Dim rngDB As Range
    Dim r As Long, c As Long
    Dim pathOut As String
    Dim i As Long

    pathOut = ThisWorkbook.Path & "\" '<~~ set your path:  C:\temp\

    Set Ws = ActiveSheet 'Sheets("AllData")
    With Ws
        r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        'c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        For i = 2 To r
            Set rngDB = .Range("a" & i).Resize(1, 6)
            FileName = .Range("a" & i).Offset(, 4)
            TransToCSV pathOut & FileName & ".txt", rngDB
        Next i
    End With
    MsgBox ("Files Saved Successfully")
End Sub

Sub TransToCSV(myfile As String, rng As Range)
    Dim vDB, vR() As String, vTxt()
    Dim i As Long, n As Long, j As Integer
    Dim objStream
    Dim strTxt As String

    Set objStream = CreateObject("ADODB.Stream")
    vDB = rng
    For i = 1 To UBound(vDB, 1)
        n = n + 1
        ReDim vR(1 To UBound(vDB, 2))
        For j = 1 To UBound(vDB, 2)
            vR(j) = vDB(i, j)
        Next j
        ReDim Preserve vTxt(1 To n)
        vTxt(n) = Join(vR, vbTab)
    Next i
    strTxt = Join(vTxt, vbCrLf)
    With objStream
        '.Charset = "utf-8"
        .WriteText strTxt
        .SaveToFile myfile, 2
    End With
    Set objStream = Nothing
End Sub

Edit: I have tried with the help of another resource and changed the code. see below. Now the it returns all the rows for each vendor code. Unlike the previous code, it does not overwrite the rows in each vendor text file, instead it appends it. But the problem with this result is columns are in separate line. What I need is to to have all the columns separated with tab-delimited in same line. Please advise how I can fix the second code. I am very close to what I need to achieve.

Sub toFile()

Dim FilePath As String, CellData As String, LastCol As Long, LastRow As Long
Dim Filenum As Integer, loc As String

LastCol = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
LastRow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

'Application.DefaultFilePath = "C:\Users\9418\Desktop\Work Files"
'loc = Application.DefaultFilePath

For i = 1 To LastRow
    FilePath = Application.DefaultFilePath & "\" & Trim(ActiveSheet.Cells(i, 1).Value) & ".txt"
    Filenum = FreeFile

    Open FilePath For Append As Filenum
    CellData = ""

    For j = 2 To LastCol
    CellData = Trim(ActiveSheet.Cells(i, j).Value)
    Print #Filenum, CellData

    Next j

    Close #Filenum

Next i
MsgBox ("Done")

End Sub

**Recent Edit:**I am posting my own answer here.

After referencing further on the internet, I finally came up with the a code below that returns all the rows per vendorcode in separate text files and the column values are also on the same line. But, now the problem with this query is that after return some text files but when there are more number of rows for a vendorcode it gives 'Over Flow' error. I have tried separating the rows in my master file into separate excel files. Each of the files have like 200-500 rows. Still it gives me the error for over flow. Please can anyone suggest what I can do to fix this error.

Option Explicit

Sub CreateFileEachLine()

Dim myPathTo As String
myPathTo = "\\901db1\IT_Canada\Vending Price Updates"
Dim myFileSystemObject As Object
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
Dim fileOut As Object
Dim myFileName As String

Dim lastRow As Long
lastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Long

    For i = 2 To lastRow
        If Not IsEmpty(Cells(i, 1)) Then
            myFileName = Cells(i, 1) & ".txt"
            Set fileOut = myFileSystemObject.OpenTextFile(myFileName, 8, True)
            fileOut.write Cells(i, 4) & "   " & Cells(i, 8) & "   " & Cells(i, 8) & "   " & Cells(i, 8) & vbNewLine
        End If

Set myFileSystemObject = Nothing
Set fileOut = Nothing

End Sub


You are working with a structured set of data. As such, the algorithm you have posted above is overly complicated for what you are trying to do.

One suggestion I have (pseudo-code) is

Set up path (pathOut) and the correct worksheet
Iterate through each row
  If FileName (Cells(1).Text & ".txt") then open file otherwise create new file
  write/append new data (Cells(2) to Cells(5)). ' Do this simply by using the string value & vbTab rather than a more complicated array function. follow up with vbCrLF
  close file

The above is simple but very inefficient (a file operation every row of code). For better efficiency, you can sort the rows to group the Vendor code and then only open and close the file once for each group. The code for this will be slightly more complex

  Set the range for the rows in each group
  Open/create the correct file for write/append
    Iterate through each row and write the data
  Close the file

For simple text files as you are describing, I prefer the simple file operations (for example see https://www.thespreadsheetguru.com/blog/vba-guide-text-files and https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/open-statement) rather than using streams. But, whether you use the simple file operations or streams, your string manipulation can be much simpler because you are using structured data. Simpler code makes it easier to debug and check.

Your Answer

By clicking "Post Your Answer", you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.