Create 2 Dimensional Array from "For" Loop

[BrI]

I'm pulling pairs of strings from text files and I need to store them in a 2-D array for each file. The number of these string pairs in each file will vary.

The resulting array should be like below for a typical file.

str_1               str_2
--------------------------
National Bank      123as
Royal Bank         456vc
Eastern Bank       789sd

The loop is below returns the strings correctly:

    str_1 = Split(txt, "Interest Holder Name:")
    str_2 = Split(txt, "Document Reference:")
    
For i = LBound(str_1) To UBound(str_1) - 1
        
        str_1 = Trim(Split(Split(txt, "Interest Holder Name:")(i + 1), " " & vbCrLf)(0))
        
        str_2 = Split(Trim(Split(txt, "Document Reference:")(i + 1)), " ")(0)
            
     Next i

How do I store the strings in a 2-D array? Thanks

[mdmackillop]

Can you post a sample of your text file.

[snb]

M_snb()  
    str_1 = Split(txt, "Interest Holder Name:")
    str_2 = Split(txt, "Document Reference:")    

    redim sp(ubound(str_1),1)
    For j = 0 To UBound(str_1) - 1            
       sp(j,0) = Trim(Split(str_1(j), " " & vbCrLf)(0))            
       sp(j,1) = Split(str_2(j), " ")(0)
    Next
end sub

[BrI]

Uploaded a sample txt file

[BrI]

@SNB - could you provide some explanation / comment on what's happening in code - I'm reading up on Arrays, but am new to them.

Any declarations required? How do I check string values - debug.print not returning - I guess because an array?

[mdmackillop]

When you have a follow up question, please provide a link to that question

Sub Test()
    Dim objFSO As Object
    Dim objTF As Object
    Dim strIn 'As String
    Dim txt
    Dim arr()
     
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objTF = objFSO.OpenTextFile("C:\VBAX\Test_4.txt", 1)
    strIn = objTF.readall
         
    strt = InStr(1, strIn, "RECORDED INTERESTS AND INSTRUMENTS")
    endd = InStr(1, strIn, "NON-ENABLING INSTRUMENTS")
         
    txt = Mid(strIn, strt, endd - strt)
          
    Do Until InStr(txt, "  ") = 0 ' Loop until there are no more double spaces
        txt = Replace(txt, "  ", " ") ' Replace 2 spaces with 1 space
    Loop
         
    strIntHlder = Split(txt, "Interest Holder Name:")
    ReDim arr(UBound(strIntHlder), 1)
    
    
    For i = LBound(strIntHlder) To UBound(strIntHlder) - 1
        arr(i, 0) = Trim(Split(Split(txt, "Interest Holder Name:")(i + 1), " " & vbCrLf)(0))
    Next i
     
    strDocRef = Split(txt, "Document Reference:")
    For i = LBound(strDocRef) To UBound(strDocRef) - 1
        arr(i, 1) = Split(Trim(Split(txt, "Document Reference:")(i + 1)), " ")(0)
    Next i
    
    Cells(1, 1).Resize(i, 2) = arr
    
End Sub

[BrI]

Will link follow up questions going forward, and thanks very much for the code ... need to spend a bit of time with this now

[snb]

Specifically written for you: http://www.snb-vba.eu/VBA_Arrays_en.html


For your file this code suffices:

Sub M_snb()
   sn = Filter(Split(Replace(Replace(CreateObject("scripting.filesystemobject").opentextfile("G:\OF\test_4.txt").readall, "Interest Holder Name: ", "@"), "Document Reference: ", "@"), vbCrLf), "@")
   ReDim sp(UBound(sn) \ 2, 1)
   
   For j = 0 To UBound(sn) Step 2
      sp(j \ 2, 0) = Mid(sn(j), 2)
      sp(j \ 2, 1) = Mid(sn(j + 1), 2)
   Next
   
   Cells(1).Resize(UBound(sp) + 1, UBound(sp, 2) + 1) = sp
End Sub

[mdmackillop]