vba extract data from text file

[drop05]

Hello, I am wondering if there is a way to select a text file and loop through the text file line by line.
each line is similar to this structure

"FORM 1","1","0","0","NAME","Diego","O"
"FORM 1","2","0","0","NAME","Pedro","O"
etc. . .

and put it into a dictionary of sorts to store the information collected from the text file and then put it into a table on a sheet in the workbook. There is 8 areas that are separated by the comma, so area 1 = form 1, area 2 is the 1 and 2, etc.

Hopefully I am thinking correctly of the process

 

[drop05]

Are you saying that want to keep the table on the left and then the user would change the various boolean values and the extracted text would change accordingly. If that is the case, where do you want the text extracted to. The same sheet and position that it is now or on a new sheet. Also do you want the extracted text as a range of data or in a table. If you want a table, do you have the name of the table.

I am not sure what the above means. Did you try the code, all blanks are removed.

So the table on the left will basically be a lsit of the forms and keys id like to look for in the text file. With that table im only looking for the ones where in column D is true so like a loop and if its true it goes to that values in column A and B, well really just B because that one tends to be different and column A is the same for some. Finding the key in the text file and extracting it to the table on the right.

The table with just the four columns is called "Table1" the table from Column F to L that table is called "Table2" they will both be located on the same sheet called "Keys"

So go through line by line in the text file, if finding any of the keys in Table 1 in column B, for example if finding "FIRST NAME" then check to see if in column D is value is true if true then extract the line and put it into Table2
if going through the lines and it finds the values key "GRADE LEVEL" that one is false in D then doesnt need to do anything just keep going on

for position of the value when grabbing would be in Table2 and in the text file they are labeled as this

"FORM 1","1","1","0","FIRST NAME","Jose","O"

Form, Section, Group, SubGroup, Key, Value

with the , separating them and how it would go when putting it into the table

Form: "FORM 1",
Section: "1",
Group: "1",
SubGroup: "0",
Key:"FIRST NAME",
Value:"Jose",

The last part with the O is nothing and can be ignored "O"

Hopefully i explained correctly, thank you sooo much!

 

[drop05]

Are you saying that want to keep the table on the left and then the user would change the various boolean values and the extracted text would change accordingly. If that is the case, where do you want the text extracted to. The same sheet and position that it is now or on a new sheet. Also do you want the extracted text as a range of data or in a table. If you want a table, do you have the name of the table.

I am not sure what the above means. Did you try the code, all blanks are removed.

oh and sorry when i put "" i was saying rather than listing the words specifically in the code like here
Do Until EOF(1)
Line Input #1, LineFromFile
Dim LineItems As Variant: LineItems = Split(LineFromFile, ",")
For i = 0 To UBound(LineItems)
If Replace(LineItems(i), """", "") = "GRADE LEVEL" Or Replace(LineItems(i), """", "") = "END GRADE 1" Then
ActiveCell.Offset(row_number, col_number + i).Value = ""
Else
ActiveCell.Offset(row_number, col_number + i).Value = Replace(LineItems(i), """", "")
End If
Next

rather than ="GRADE LEVEL"
it was just checking the key column in the table1 then check in column D if its true then grab the values and paste the value into the next available cell in table2
not sure what would be best/easiest
if you dont mind explaining from your knowledge
i think i understand that code above, the replace is kinda throwing me off

 

[igold]

Ok, the only thing I am not sure about (I think), is the order of the columns. This code is using the Table Names you provided in Post #11, on a sheet named "Keys". If you change the BoolVal the text retrieved will change.

Sub TextFlie()

    Dim arr, arr2, crit, boolines
    Dim ws As Worksheet: Set ws = Worksheets("Keys")
    Dim row_number As Long, col_number As Long, i As Long, ct As Long, c As Long, x As Long
    Dim a As Long, b As Long, d As Long, e As Long, lrow As Long
    Dim LineFromFile As Variant
    Dim FilePath As String, boo As String
    Dim tbl As ListObject, rng As Range
    
    FilePath = "G:\Excel VBA\drop05.txt"    'Change path here"
    Close #1
    Open FilePath For Input As #1
    Do Until EOF(1)
        Line Input #1, LineFromFile
        ct = ct + 1
    Loop
    crit = ws.ListObjects("Table1").DataBodyRange
    ReDim arr(1 To ct, 1 To 7)
    ReDim arr2(1 To ct, 1 To 7)
    c = 1
    Close #1
    Open FilePath For Input As #1
    Do Until EOF(1)
        Line Input #1, LineFromFile
        Dim LineItems As Variant: LineItems = Split(LineFromFile, ",")
        For x = 0 To UBound(LineItems)
                arr(c, x + 1) = Replace(LineItems(x), """", "")
        Next
        c = c + 1
    Loop

    For a = 1 To UBound(crit)
        If crit(a, 4) = False Then
            boo = boo & "," & crit(a, 2)
        End If
    Next
    ct = 1
    boo = Mid(boo, 2)
    boolines = Split(boo, ",")
    For b = 1 To UBound(arr)
        For d = 0 To UBound(boolines)
            If arr(b, 5) = boolines(d) Then
                arr(b, 5) = ""
            End If
        Next
        If arr(b, 5) <> "" Then
             For e = 1 To 7
                arr2(ct, e) = arr(b, e)
            Next
            ct = ct + 1
        End If
    Next

    Set tbl = ActiveSheet.ListObjects("Table2")
    With tbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With

    tbl.DataBodyRange(1, 1).Resize(UBound(arr2, 1), 6) = arr2
    lrow = Range("F1").End(xlDown).Row
    Set rng = Range("Table2[#All]").Resize(lrow, 7)
    ws.ListObjects("Table2").Resize rng
    
End Sub

 

[drop05]

Ok, the only thing I am not sure about (I think), is the order of the columns. This code is using the Table Names you provided in Post #11, on a sheet named "Keys". If you change the BoolVal the text retrieved will change.

Sub TextFlie()

    Dim arr, arr2, crit, boolines
    Dim ws As Worksheet: Set ws = Worksheets("Keys")
    Dim row_number As Long, col_number As Long, i As Long, ct As Long, c As Long, x As Long
    Dim a As Long, b As Long, d As Long, e As Long, lrow As Long
    Dim LineFromFile As Variant
    Dim FilePath As String, boo As String
    Dim tbl As ListObject, rng As Range
   
    FilePath = "G:\Excel VBA\drop05.txt"    'Change path here"
    Close #1
    Open FilePath For Input As #1
    Do Until EOF(1)
        Line Input #1, LineFromFile
        ct = ct + 1
    Loop
    crit = ws.ListObjects("Table1").DataBodyRange
    ReDim arr(1 To ct, 1 To 7)
    ReDim arr2(1 To ct, 1 To 7)
    c = 1
    Close #1
    Open FilePath For Input As #1
    Do Until EOF(1)
        Line Input #1, LineFromFile
        Dim LineItems As Variant: LineItems = Split(LineFromFile, ",")
        For x = 0 To UBound(LineItems)
                arr(c, x + 1) = Replace(LineItems(x), """", "")
        Next
        c = c + 1
    Loop

    For a = 1 To UBound(crit)
        If crit(a, 4) = False Then
            boo = boo & "," & crit(a, 2)
        End If
    Next
    ct = 1
    boo = Mid(boo, 2)
    boolines = Split(boo, ",")
    For b = 1 To UBound(arr)
        For d = 0 To UBound(boolines)
            If arr(b, 5) = boolines(d) Then
                arr(b, 5) = ""
            End If
        Next
        If arr(b, 5) <> "" Then
             For e = 1 To 7
                arr2(ct, e) = arr(b, e)
            Next
            ct = ct + 1
        End If
    Next

    Set tbl = ActiveSheet.ListObjects("Table2")
    With tbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With

    tbl.DataBodyRange(1, 1).Resize(UBound(arr2, 1), 6) = arr2
    lrow = Range("F1").End(xlDown).Row
    Set rng = Range("Table2[#All]").Resize(lrow, 7)
    ws.ListObjects("Table2").Resize rng
   
End Sub

Sounds good, will check this out and mess around with it, hmm on the topic on the header name could something by making it a string and integer a thought?

for example:

setting the table as a range so, if im writing this right

dim tbl as listobject
set tbl = shtKey.ListObjects("Table1")

dim rng as range
set rng = shtKey.listObjects("Table1").listcolumns(1).databodyrange

keyName = tbl.DataBodyRange(i, 2).value




with sht key being the vba name for the sheet named "Keys" where the tables are located, not sure if i wrote that correctly or not, but avoiding that if the name of the header changes, i guess mainly trying to say like setting the columns as a name in the vba

because if i understood if i change the header "BoolVal" to something like "ValBool" an error will occur?

 

[igold]

You can change the header names in the tables. The code is not using them.

 

[drop05]

You can change the header names in the tables. The code is not using them.

Oh okay, sorry I have some confusion on when you mentioned “If you change the BoolVal the text retrieved will change”

By change do you mean if I change the position of the column in which BoolVal is in?

 

[igold]

No, you can not move the columns around. I mean you can, but the code would have to be changed. As far as the actual name of each column goes, they can be named anything you want.

“If you change the BoolVal the text retrieved will change”

The text that is retrieved is dependent upon if that column is TRUE of FALSE. If TRUE that data is returned. If FALSE that data is not returned. That is how I understood your requirement.

 

[drop05]

No, you can not move the columns around. I mean you can, but the code would have to be changed. As far as the actual name of each column goes, they can be named anything you want.

The text that is retrieved is dependent upon if that column is TRUE of FALSE. If TRUE that data is returned. If FALSE that data is not returned. That is how I understood your requirement.

Oh I see okay makes sense thank you for that. Sorry just trying to also read the code and understand what it is doing by the area I understand for the most part, I believe, going to try it out here soon with some testing txt files

Ok, the only thing I am not sure about (I think), is the order of the columns. This code is using the Table Names you provided in Post #11, on a sheet named "Keys". If you change the BoolVal the text retrieved will change.

Sub TextFlie()

    Dim arr, arr2, crit, boolines
    Dim ws As Worksheet: Set ws = Worksheets("Keys")
    Dim row_number As Long, col_number As Long, i As Long, ct As Long, c As Long, x As Long
    Dim a As Long, b As Long, d As Long, e As Long, lrow As Long
    Dim LineFromFile As Variant
    Dim FilePath As String, boo As String
    Dim tbl As ListObject, rng As Range
   
    FilePath = "G:\Excel VBA\drop05.txt"    'Change path here"
    Close #1
    Open FilePath For Input As #1
    Do Until EOF(1)
        Line Input #1, LineFromFile
        ct = ct + 1
    Loop
    crit = ws.ListObjects("Table1").DataBodyRange
    ReDim arr(1 To ct, 1 To 7)
    ReDim arr2(1 To ct, 1 To 7)
    c = 1
    Close #1
    Open FilePath For Input As #1
    Do Until EOF(1)
        Line Input #1, LineFromFile
        Dim LineItems As Variant: LineItems = Split(LineFromFile, ",")
        For x = 0 To UBound(LineItems)
                arr(c, x + 1) = Replace(LineItems(x), """", "")
        Next
        c = c + 1
    Loop

    For a = 1 To UBound(crit)
        If crit(a, 4) = False Then
            boo = boo & "," & crit(a, 2)
        End If
    Next
    ct = 1
    boo = Mid(boo, 2)
    boolines = Split(boo, ",")
    For b = 1 To UBound(arr)
        For d = 0 To UBound(boolines)
            If arr(b, 5) = boolines(d) Then
                arr(b, 5) = ""
            End If
        Next
        If arr(b, 5) <> "" Then
             For e = 1 To 7
                arr2(ct, e) = arr(b, e)
            Next
            ct = ct + 1
        End If
    Next

    Set tbl = ActiveSheet.ListObjects("Table2")
    With tbl.DataBodyRange
        If .Rows.Count > 1 Then
            .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
        End If
    End With

    tbl.DataBodyRange(1, 1).Resize(UBound(arr2, 1), 6) = arr2
    lrow = Range("F1").End(xlDown).Row
    Set rng = Range("Table2[#All]").Resize(lrow, 7)
    ws.ListObjects("Table2").Resize rng
   
End Sub

no makes sense I will leave the order as is I don’t see myself adding more. By any chance just because I’m trying to see parts of the looping structure and understand it, could you leave a comment on what thispart is looking at. For example the first statements, one I’m trying to see if I can edit to replace the for e= 1 to 7 looking at possibly changing to e=1 to like a databodyrange(x,1) or something because the table will grow just had 7 for an example so like until the last row but the row being a X or something because not sure what it will be at the moment and possible to change

 

[igold]

Sure, I can make the code a drop more flexible and comment some of the areas to help you understand what is going on..

 

[drop05]

Sure, I can make the code a drop more flexible and comment some of the areas to help you understand what is going on..

That would be wonderful! I couldn’t thank you enough like this is more helpful and learning then the boot camp I’m doing right now I’m not going to lie