writing/creating multiple .txt files from excel data

[prof_puppies]

I have attempted to search this forum for a solution to something that would be extremely helpful and timesaving for me moving forward. So far most of what I had found wasn't exactly what my situation is so let me try to explain what I am attempting to do. I have 2 columns with multiple rows of data. Example is this

COL. A COL. B
AA1 COORDS
AA1 1,1,Y,0,T
AA1 1,2,Y,-14.46,T
AA1 1,3,Y,-25.88,T
AA1 1,4,Y,-40.35,T
AA1 1,1,Y,0,L
AA2 COORDS
AA2 1,1,Y,-23.8,T
AA2 1,2,Y,-36.96,T
AA2 1,3,Y,-21.57,T
AA2 1,4,Y,-33.63,T
AA2 1,1,Y,-21.08,L

and so on and so forth all the way down to AA200. What I am trying to do is create separate .txt files from this. For example I would get is

text file titled AA1.txt and inside that text file it would just have
COORDS
1,1,Y,0,T
1,2,Y,-14.46,T
1,3,Y,-25.88,T
1,4,Y,-40.35,T
1,1,Y,0,L

next text file would be titled AA2.txt and inside that text file it would just have
COORDS
1,1,Y,-23.8,T
1,2,Y,-36.96,T
1,3,Y,-21.57,T
1,4,Y,-33.63,T
1,1,Y,-21.08,L

in the end I would be left with a folder containing 200 .txt files which would have only the contents I have described in each one. Hoping this is possible in Excel but so far mostly what I had found was just exporting single rows as .txt files.

 

[Domenic]

Try the following code, which needs to be placed in a regular module (Visual Basic Editor >> Insert >> Module).

Note that the code assumes that the worksheet containing the data is the active sheet. Also, it assumes that the specified destination path exists. Change the destination path accordingly.

Option Explicit

Sub CreateTextFiles()

    Dim data As Variant
    data = Range("A1").CurrentRegion.Value
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    Dim key As String
    Dim item As String
    For i = LBound(data, 1) To UBound(data, 1)
        key = data(i, 1)
        item = data(i, 2)
        If item = "COORDS" Then
            dic(key) = item
        Else
            dic(key) = dic(key) & vbCrLf & item
        End If
    Next i
    
    Dim destinationPath As String
    destinationPath = "c:\users\domenic\desktop\" 'change the destination path accordingly
    If Right(destinationPath, 1) <> "\" Then
        destinationPath = destinationPath & "\"
    End If
    
    With dic
        Dim j As Long
        For j = 0 To .Count - 1
            exportTextFile destinationPath, dic.keys()(j) & ".txt", dic.items()(j)
        Next j
    End With
    
End Sub

Sub exportTextFile(ByVal destinationPath As String, ByVal filename As String, ByVal contents As String)

    Dim fileNumber As Long
    fileNumber = FreeFile()
    
    Open destinationPath & filename For Output As #fileNumber
        Print #fileNumber, contents
    Close #fileNumber
    
End Sub

Hope this helps!

 

[prof_puppies]

Try the following code, which needs to be placed in a regular module (Visual Basic Editor >> Insert >> Module).

Note that the code assumes that the worksheet containing the data is the active sheet. Also, it assumes that the specified destination path exists. Change the destination path accordingly.

Option Explicit

Sub CreateTextFiles()

    Dim data As Variant
    data = Range("A1").CurrentRegion.Value
   
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
   
    Dim i As Long
    Dim key As String
    Dim item As String
    For i = LBound(data, 1) To UBound(data, 1)
        key = data(i, 1)
        item = data(i, 2)
        If item = "COORDS" Then
            dic(key) = item
        Else
            dic(key) = dic(key) & vbCrLf & item
        End If
    Next i
   
    Dim destinationPath As String
    destinationPath = "c:\users\domenic\desktop\" 'change the destination path accordingly
    If Right(destinationPath, 1) <> "\" Then
        destinationPath = destinationPath & "\"
    End If
   
    With dic
        Dim j As Long
        For j = 0 To .Count - 1
            exportTextFile destinationPath, dic.keys()(j) & ".txt", dic.items()(j)
        Next j
    End With
   
End Sub

Sub exportTextFile(ByVal destinationPath As String, ByVal filename As String, ByVal contents As String)

    Dim fileNumber As Long
    fileNumber = FreeFile()
   
    Open destinationPath & filename For Output As #fileNumber
        Print #fileNumber, contents
    Close #fileNumber
   
End Sub

Hope this helps!

Domenic - you rock !! This is working perfectly. Thank you so much you have saved me countless hours.