Crypto-enthusiast
Crypto-enthusiast

Reputation: 21

VBA: Creating a .txt file containing an array of arrays from a table of data

I have a 20x3 table on an excel sheet. Each of the three columns is labeled Date, Price, and Volume. I want to convert this data into a .txt file that contains an array of array, i.e an array containing twenty arrays, where each of the twenty arrays has the format [Date, price, volume]. The final array should have the format:

[[Date_0, Price_0, Volume_0], . . .,[Date_19, Price_19, Volume_19]].

I believe this can be done by writing a loop for each row and printing as an array.

Upvotes: 2

Views: 309

Answers (2)

Taylor Raine
Taylor Raine

Reputation: 578

This is a modification from the above that will take input as a range. It is capable of handling ranges with several areas (multiselection).

Public Sub writeRangeToFile(ByRef rng As Range, ByVal path As String)

    Dim fso     As Object, _
        fOut    As Object, _
        rArea   As Range, _
        row     As Integer, _
        col     As Integer

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fOut = fso.CreateTextFile(path, overwrite:=True, Unicode:=False)

    With fOut
        For Each rArea In rng.Areas '' iterate over areas of range, insures all are rects
            fOut.Write "["
            For row = 1 To rArea.Rows.Count Step 1
                .Write IIf(row > 1, ",", "") & "["
                For col = 1 To rArea.Columns.Count Step 1
                    .Write IIf(col > 1, ",", "") & rArea.Cells(row, col).Value
                Next col
                .Write "]"
            Next row
            .Write "]" & vbCrLf
        Next rArea
        .Close
    End With

End Sub

Tester

This serves as a general test case, but I think you would want to use a named range in place of Selection in your case

Sub tester()
   writeRangeToFile Selection, "C:\[your directory]\Test.txt"
End Sub

Output

Given the selection of

Selection

the tester function outputs

[[B2,C2,D2,E2,F2,G2],[B3,C3,D3,E3,F3,G3],[B4,C4,D4,E4,F4,G4],[B5,C5,D5,E5,F5,G5]]
[[M3,N3,O3,P3,Q3],[M4,N4,O4,P4,Q4],[M5,N5,O5,P5,Q5],[M6,N6,O6,P6,Q6],[M7,N7,O7,P7,Q7],[M8,N8,O8,P8,Q8]]
[[D10,E10,F10,G10,H10,I10,J10],[D11,E11,F11,G11,H11,I11,J11],[D12,E12,F12,G12,H12,I12,J12],[D13,E13,F13,G13,H13,I13,J13],[D14,E14,F14,G14,H14,I14,J14],[D15,E15,F15,G15,H15,I15,J15],[D16,E16,F16,G16,H16,I16,J16]]
[[Q15,R15,S15,T15],[Q16,R16,S16,T16],[Q17,R17,S17,T17],[Q18,R18,S18,T18],[Q19,R19,S19,T19],[Q20,R20,S20,T20]]

Upvotes: 2

Taylor Raine
Taylor Raine

Reputation: 578

You can do this using the Open path For Output call, and then by iterating across the array in both directions.

Sub writeArrToFile(ByRef arr() As String, ByVal path As String)

    Dim lOuter As Integer, _
        uOuter As Integer, _
        lInner As Integer, _
        uInner As Integer

    Open path For Output As #1
    Let lOuter = LBound(arr(), 1)
    Let uOuter = UBound(arr(), 1)
    Let lInner = LBound(arr(), 2)
    Let uInner = UBound(arr(), 2)

    Print #1, "[";
    For i = lOuter To uOuter
        Print #1, IIf(i > lOuter, ",", ""); "[";
        For j = lInner To uInner
            Print #1, IIf(j > lInner, ",", ""); arr(i, j);
        Next j
        Print #1, "]";
    Next i
    Print #1, "]";
    Close #1
End Sub

or you may achieve this by using a more modern, object oriented approach with

Sub writeArrToFile(ByRef arr() As String, ByVal path As String)

    Dim fso     As Object, _
        fOut    As Object, _
        lInner  As Integer, _
        lOuter  As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fOut = fso.CreateTextFile(path, overwrite:=True, Unicode:=False)

    Let lInner = LBound(arr(), 2)
    Let uInner = UBound(arr(), 2)

    With fOut
        .Write "["
        For i = LBound(arr(), 1) To UBound(arr(), 1) Step 1
            .Write IIf(i > lOuter, ",", "") & "["
            For j = lInner To uInner
                .Write IIf(j > lInner, ",", "") & arr(i, j)
            Next j
            .Write "]"
        Next i
        .Write "]"
        .Close
    End With
End Sub

Tester Function

You can test the above with this function. Modify the file path to designate where the subroutine should output.

Sub tester()
    Dim arr(0 To 2, 0 To 2) As String

    arr(0, 0) = "a"
    arr(0, 1) = "b"
    arr(0, 2) = "c"
    arr(1, 0) = "d"
    arr(1, 1) = "e"
    arr(1, 2) = "f"
    arr(2, 0) = "g"
    arr(2, 1) = "h"
    arr(2, 2) = "i"

    writeArrToFile arr, "C:\[your directory]\Test.txt"
End Sub

Output

The above tester function outputs to "C:\[your directory]\Test.txt"

[[a,b,c],[d,e,f],[g,h,i]]

Upvotes: 1

Related Questions