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, leng 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
'Loop to determine the number of lines and columns in the text file.
Do Until EOF(1)
Line Input #1, LineFromFile
ct = ct + 1
leng = UBound(Split(LineFromFile, ",")) + 1
Loop
'*********************
'This assigns the DataBodyRange of Table1 to the array named "crit"
crit = ws.ListObjects("Table1").DataBodyRange
'*********************
'Dimension two arrays to the size of the text file
ReDim arr(1 To ct, 1 To leng)
ReDim arr2(1 To ct, 1 To leng)
c = 1
Close #1
Open FilePath For Input As #1
'Loop to split the text file and write it to an array named "arr"
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), """", "") 'Replace is removing the quotes from the text between the commas
Next
c = c + 1
Loop
'**********************************
'Check to see which rows of Table1 are FALSE and put that criteria in a string
For a = 1 To UBound(crit)
If crit(a, 4) = False Then
boo = boo & "," & crit(a, 2)
End If
Next
'******************************
ct = 1
'Split out the text of the criteria from the created string
boo = Mid(boo, 2)
boolines = Split(boo, ",")
'***********************************
'Apply criteria to the array "arr" that contains the contents of the text file
'Write the filtered array "arr" to a new array named "arr2"
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 leng
arr2(ct, e) = arr(b, e)
Next
ct = ct + 1
End If
Next
'*************************************
'Clear existing Table2
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
'**************************
'Write new data to Table2 and resize
tbl.DataBodyRange(1, 1).Resize(UBound(arr2, 1), 6) = arr2
lrow = Range("F1").End(xlDown).Row
Set rng = Range("Table2[#All]").Resize(lrow, leng)
ws.ListObjects("Table2").Resize rng
'*****************************
End Sub
