Import new data from a text file based on certain field criteria.

[maudedog]

I have a little VB knowledge but this one is way beyond my scope. This is a multipart problem I am trying to find a solution.

We have a tab delineated text file with 11 fields that is constantly updated by another program. We would like to copy/import just two fields of that data, let’s say fields #9 & #11 into Excel but only bring in the new data since the previous import. So if initially there are 5 lines of data, that would come in and populate the first 5 rows and 2 columns in a worksheet. Then subsequently it would bring in only anything added after the initial copy/import. I have been able to write a routine that simply copies everything and overwrites what is there but this is not what we want.

The next part of this is that based on certain criteria, the data will be copied/imported into certain columns. The criteria variables will be in fields #2 and #6. So for example, if field #2 = 1, and field #6 = 2, then fields #9 & #11 will go in columns A & B. If field #2 = 2 and field #6 = 1, then fields #9 & #11 will go into columns C&D. There would most likely be 6 possible combinations of those variables (1/1, ½, 1/3, 2/1, 2/2, 2/3) so columns A-L could be populated. Note that field #9 could be blank in which case it would just bring in field #11 or just copy the blank text. These variable numbers could be referenced to cells in the workbook where we select which variables will correspond to which columns. For example if we wanted columns A & B to contain the data with the variables 1 & 2, cells G1 & H1 could have #1 & #2 in their cells if that is helpful. There may be times when we want that variable combo of 2/1 to go into cells A & B.

Here is the text file:

0 1 2 0 0 1 b 1648 1648 9:55:02.61 09:55:03
0 2 5 0 0 1 b 1648 1659 9:57:45.70 09:57:46
0 2 7 0 0 2 b 1649 1649 9:58:09.84 09:58:10
0 3 8 0 0 1 s 9:58:09.87 09:58:10
0 1 9 0 0 1 b 1656 1656 9:58:13.80 09:58:15
0 1 11 0 0 1 b 1657 1657 9:58:19.88 09:58:20
0 3 12 0 0 1 s 9:58:19.93 09:58:20
0 1 13 0 0 1 b 1663 1663 9:58:25.77 09:58:26
0 1 14 0 0 2 s 9:58:25.78 09:58:26
0 1 15 0 0 2 s 9:59:22.40 09:59:23
0 2 16 0 0 1 b 1664 1664 9:59:22.41 09:59:23
0 2 17 0 0 2 s 1671 1671 9:59:26.33 09:59:27

I have attached a copy of screenshots of the text file along with what the workbook could look like.

The last part is ideally this routine would only run when the text file has been updated but I am not sure how possible that is. Otherwise I can just put this on a timer that will run every minute or so.

Being a bit of neophyte with VBA I have found this forum to be an awesome resource so I hope I have explained this correctly. If this info is already posted somewhere please point me in that direction. I am always willing to learn but this one is bit beyond me right now.

As always, many thanks in advance.

 

[maudedog]

Can you please add headers to the text file table? Can't tell what column relates to the final output.

Sorry about that, simply lazy on my part. I just uploaded updated text & Excel files that correspond.

Thanks again for taking a swing at this!

timer_data.txt
	A
1	col_1
timer_data

Sample workbook.xlsx
	O
6
Sheet1

 

[jdellasala]

Give me a URL. What you get varies immensely, but a sample URL is a start.

IGNORE! Wrong thread. Sorry!

 

[maudedog]

Give me a URL. What you get varies immensely, but a sample URL is a start.

Hmm, I thought I did use XL2BB but here is a link to download both files: Google Drive: Sign-in

 

[jdellasala]

Hmm, I thought I did use XL2BB but here is a link to download both files: Google Drive: Sign-in

You did use XL2BB, but you only put in one cell. Go look at it. Hit the Preview button at the top right to see what the post will look like before you post. In XL2BB, highlight the range you want to copy and then use Mini Sheet. I haven't used Table Only yet. Feel free to try it though!
As for that URL, you're not going to pull data from that. When you first connect to a Domain that needs authentication, you'll be presented with several authentication methods. The simple one that just wants User ID and Password should be the one that works. HOWEVER, it may not work, and I don't know why. I want to connect to finance.yahoo.com with my ID and Password, but it never works. I think I'd have the API to connect, and that's way beyond my knowledge!

 

[maudedog]

You did use XL2BB, but you only put in one cell. Go look at it. Hit the Preview button at the top right to see what the post will look like before you post. In XL2BB, highlight the range you want to copy and then use Mini Sheet. I haven't used Table Only yet. Feel free to try it though!
As for that URL, you're not going to pull data from that. When you first connect to a Domain that needs authentication, you'll be presented with several authentication methods. The simple one that just wants User ID and Password should be the one that works. HOWEVER, it may not work, and I don't know why. I want to connect to finance.yahoo.com with my ID and Password, but it never works. I think I'd have the API to connect, and that's way beyond my knowledge!

For a URL, I thought you meant a link to download the text & Excel files?? Here is the proper XL2bb content (sorry, only on my second espresso...)

Sample workbook.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	1/1		1/2		1/3		2/1		2/2		2/3		3/1		3/2		3/3
2	54	10:30:45	29	10:35:16	91	10:37:45	38	10:32:30	81	10:35:47	36	10:38:21		10:33:40		10:37:09		10:38:42
3	42	10:31:26	80	10:35:47	95	10:37:45	39	10:32:30	45	10:36:42	30	10:38:28		10:34:33		10:37:42	37	10:38:54
Sheet1

timer_data.txt
	A	B	C	D	E	F	G	H	I	J	K
1	col_1	col_2	col_3	col_4	col_5	col_6	col_7	col_8	col_9	col_10	col_11
2	0	1	2	0	0	1	b	54	54	00:44.8	10:30:45
3	0	1	3	0	0	1	b	42	42	01:25.3	10:31:26
4	0	2	4	0	0	1	b	38	38	02:28.8	10:32:30
5	0	2	5	0	0	1	b	39	39	02:30.6	10:32:30
6	0	3	6	0	0	1	b			03:39.5	10:33:40
7	0	3	7	0	0	1	b			04:31.2	10:34:33
8	0	1	8	0	0	2	b	29	29	05:15.3	10:35:16
9	0	1	9	0	0	2	b	80	80	05:46.0	10:35:47
10	0	2	10	0	0	2	b	81	81	05:47.1	10:35:47
11	0	2	11	0	0	2	b	45	45	06:41.2	10:36:42
12	0	3	12	0	0	2	b			07:07.2	10:37:09
13	0	3	13	0	0	2	b			07:40.7	10:37:42
14	0	1	14	0	0	3	b	91	91	07:43.3	10:37:45
15	0	1	15	0	0	3	b	95	95	07:44.7	10:37:45
16	0	2	16	0	0	3	b	36	36	08:21.3	10:38:21
17	0	2	17	0	0	3	b	30	30	08:26.6	10:38:28
18	0	3	18	0	0	3	b			08:41.6	10:38:42
19	0	3	19	0	0	3	b	37	37	08:54.6	10:38:54
timer_data

 

[jdellasala]

For a URL, I thought you meant a link to download the text & Excel files?? Here is the proper XL2bb content (sorry, only on my second espresso...)

Sample workbook.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R
1	1/1		1/2		1/3		2/1		2/2		2/3		3/1		3/2		3/3
2	54	10:30:45	29	10:35:16	91	10:37:45	38	10:32:30	81	10:35:47	36	10:38:21		10:33:40		10:37:09		10:38:42
3	42	10:31:26	80	10:35:47	95	10:37:45	39	10:32:30	45	10:36:42	30	10:38:28		10:34:33		10:37:42	37	10:38:54
Sheet1

timer_data.txt
	A	B	C	D	E	F	G	H	I	J	K
1	col_1	col_2	col_3	col_4	col_5	col_6	col_7	col_8	col_9	col_10	col_11
2	0	1	2	0	0	1	b	54	54	00:44.8	10:30:45
3	0	1	3	0	0	1	b	42	42	01:25.3	10:31:26
4	0	2	4	0	0	1	b	38	38	02:28.8	10:32:30
5	0	2	5	0	0	1	b	39	39	02:30.6	10:32:30
6	0	3	6	0	0	1	b			03:39.5	10:33:40
7	0	3	7	0	0	1	b			04:31.2	10:34:33
8	0	1	8	0	0	2	b	29	29	05:15.3	10:35:16
9	0	1	9	0	0	2	b	80	80	05:46.0	10:35:47
10	0	2	10	0	0	2	b	81	81	05:47.1	10:35:47
11	0	2	11	0	0	2	b	45	45	06:41.2	10:36:42
12	0	3	12	0	0	2	b			07:07.2	10:37:09
13	0	3	13	0	0	2	b			07:40.7	10:37:42
14	0	1	14	0	0	3	b	91	91	07:43.3	10:37:45
15	0	1	15	0	0	3	b	95	95	07:44.7	10:37:45
16	0	2	16	0	0	3	b	36	36	08:21.3	10:38:21
17	0	2	17	0	0	3	b	30	30	08:26.6	10:38:28
18	0	3	18	0	0	3	b			08:41.6	10:38:42
19	0	3	19	0	0	3	b	37	37	08:54.6	10:38:54
timer_data

I'm out.

 

[maudedog]

I'm out.

Sorry, I tried

 

[mmhill]

mmhill - Awesome - thanks for posting this so quickly. I just tried to run this but I am getting a "subscript out of range error" at:
View attachment 80556
Any ideas?

I am pretty sure it's because the text file you are using is space deliminated and not tab deliminated. This code has a function added so it will take either.
It also auto adjusts for the lines that are missing the 4 digit numbers, but that is hard coded. If that changes, you have to edit these two lines. The 10 in Line 1 is the number of fields you expect. The 7 in line 2 is the field after which you want to add Tabs so your times end up in the last 2 fields.

        tmp = 10 - (Len(ayData(i)) - Len(Replace(ayData(i), vbTab, "")))
        ayData(i) = Application.WorksheetFunction.Substitute(ayData(i), vbTab, String(1 + tmp, vbTab), 7)

Here is the full code

Sub TableMagic()
Dim strTextFile$, rngOutputAnchor As Range
Dim objFSO, strData$, tmpData$, ayLines, ayBody(), i%, ayOutput(), ayRows(), tmp
Dim c1%, c2%, ayOutputTable
Const ForReading = 1

'------------------------------------------------------
'name of the text file
strTextFile = "C:\Users\JoeSchmoe\Downloads\@TEST\TEST.txt"
'top left cell of your output table
Set rngOutputAnchor = ThisWorkbook.Worksheets("TESTTABLE").Range("$B$28")
'------------------------------------------------------

'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile, ForReading).ReadAll

ayBody = pfStringToArray(strData)

ReDim ayOutput(1 To 12, 1 To 1)
ReDim ayRows(1 To 12)

For i = 0 To UBound(ayBody)

    'first output column is a function of ayBody (1) and (5)
    c1 = ((ayBody(i)(1) - 1) * 4) + ((ayBody(i)(5) - 1) * 2) + 1
    c2 = c1 + 1
    
    ayRows(c1) = ayRows(c1) + 1: ayRows(c2) = ayRows(c2) + 1
    If UBound(ayOutput, 2) < ayRows(c1) Then ReDim Preserve ayOutput(1 To 12, 1 To ayRows(c1))
    
    ayOutput(c1, ayRows(c1)) = ayBody(i)(8)
    ayOutput(c1 + 1, ayRows(c1)) = ayBody(i)(10)
    
Next i

    ayOutputTable = Application.WorksheetFunction.Transpose(ayOutput)
    rngOutputAnchor.Resize(UBound(ayOutputTable, 1), 12) = ayOutputTable
    
'Cleanup
Set objFSO = Nothing
Set rngOutputAnchor = Nothing
Exit Sub

WriteTextFileToSpreadsheet:
    Dim r%, c%
    r = -1: c = -1
    With rngOutputAnchor
        For r = 0 To UBound(ayBody)
            For c = 0 To UBound(ayBody(r))
                .Offset(r, c) = ayBody(r)(c)
            Next c
        Next r
    End With
End Sub

Private Function pfStringToArray(ByVal strData$) As Variant
Dim ayData, iAdj%, ayBody(), booSpace As Boolean, i%, lenStart%, lenEnd%, tmp

    ayData = Split(strData, vbCrLf)
    
    If Len(ayData(UBound(ayData))) = 0 Then iAdj = 1 Else iAdj = 0
    ReDim ayBody(0 To UBound(ayData) - iAdj)
    
    'test for space deliminated (vs tab deliminated)
    booSpace = (Len(strData) - Len(Replace(strData, vbTab, ""))) = 0

    'create a deliminated array for each ayData line
    For i = 0 To UBound(ayBody)
        If booSpace Then
            Do
                lenStart = Len(ayData(i))
                ayData(i) = Replace(ayData(i), "  ", " ")
                lenEnd = Len(ayData(i))
            Loop Until lenStart = lenEnd
            ayData(i) = Replace(ayData(i), " ", vbTab)
        End If
        
        tmp = 10 - (Len(ayData(i)) - Len(Replace(ayData(i), vbTab, "")))
        ayData(i) = Application.WorksheetFunction.Substitute(ayData(i), vbTab, String(1 + tmp, vbTab), 7)
        
        ayBody(i) = Split(ayData(i), vbTab)
    Next i

    pfStringToArray = ayBody

End Function

 

[maudedog]

I am pretty sure it's because the text file you are using is space deliminated and not tab deliminated. This code has a function added so it will take either.
It also auto adjusts for the lines that are missing the 4 digit numbers, but that is hard coded. If that changes, you have to edit these two lines. The 10 in Line 1 is the number of fields you expect. The 7 in line 2 is the field after which you want to add Tabs so your times end up in the last 2 fields.

        tmp = 10 - (Len(ayData(i)) - Len(Replace(ayData(i), vbTab, "")))
        ayData(i) = Application.WorksheetFunction.Substitute(ayData(i), vbTab, String(1 + tmp, vbTab), 7)

Here is the full code

Sub TableMagic()
Dim strTextFile$, rngOutputAnchor As Range
Dim objFSO, strData$, tmpData$, ayLines, ayBody(), i%, ayOutput(), ayRows(), tmp
Dim c1%, c2%, ayOutputTable
Const ForReading = 1

'------------------------------------------------------
'name of the text file
strTextFile = "C:\Users\JoeSchmoe\Downloads\@TEST\TEST.txt"
'top left cell of your output table
Set rngOutputAnchor = ThisWorkbook.Worksheets("TESTTABLE").Range("$B$28")
'------------------------------------------------------

'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile, ForReading).ReadAll

ayBody = pfStringToArray(strData)

ReDim ayOutput(1 To 12, 1 To 1)
ReDim ayRows(1 To 12)

For i = 0 To UBound(ayBody)

    'first output column is a function of ayBody (1) and (5)
    c1 = ((ayBody(i)(1) - 1) * 4) + ((ayBody(i)(5) - 1) * 2) + 1
    c2 = c1 + 1
  
    ayRows(c1) = ayRows(c1) + 1: ayRows(c2) = ayRows(c2) + 1
    If UBound(ayOutput, 2) < ayRows(c1) Then ReDim Preserve ayOutput(1 To 12, 1 To ayRows(c1))
  
    ayOutput(c1, ayRows(c1)) = ayBody(i)(8)
    ayOutput(c1 + 1, ayRows(c1)) = ayBody(i)(10)
  
Next i

    ayOutputTable = Application.WorksheetFunction.Transpose(ayOutput)
    rngOutputAnchor.Resize(UBound(ayOutputTable, 1), 12) = ayOutputTable
  
'Cleanup
Set objFSO = Nothing
Set rngOutputAnchor = Nothing
Exit Sub

WriteTextFileToSpreadsheet:
    Dim r%, c%
    r = -1: c = -1
    With rngOutputAnchor
        For r = 0 To UBound(ayBody)
            For c = 0 To UBound(ayBody(r))
                .Offset(r, c) = ayBody(r)(c)
            Next c
        Next r
    End With
End Sub

Private Function pfStringToArray(ByVal strData$) As Variant
Dim ayData, iAdj%, ayBody(), booSpace As Boolean, i%, lenStart%, lenEnd%, tmp

    ayData = Split(strData, vbCrLf)
  
    If Len(ayData(UBound(ayData))) = 0 Then iAdj = 1 Else iAdj = 0
    ReDim ayBody(0 To UBound(ayData) - iAdj)
  
    'test for space deliminated (vs tab deliminated)
    booSpace = (Len(strData) - Len(Replace(strData, vbTab, ""))) = 0

    'create a deliminated array for each ayData line
    For i = 0 To UBound(ayBody)
        If booSpace Then
            Do
                lenStart = Len(ayData(i))
                ayData(i) = Replace(ayData(i), "  ", " ")
                lenEnd = Len(ayData(i))
            Loop Until lenStart = lenEnd
            ayData(i) = Replace(ayData(i), " ", vbTab)
        End If
      
        tmp = 10 - (Len(ayData(i)) - Len(Replace(ayData(i), vbTab, "")))
        ayData(i) = Application.WorksheetFunction.Substitute(ayData(i), vbTab, String(1 + tmp, vbTab), 7)
      
        ayBody(i) = Split(ayData(i), vbTab)
    Next i

    pfStringToArray = ayBody

End Function

Thanks for this however I am getting an error on this line. I rechecked the file path and that is not causing the error. I tried debugging by bypassing the pfStringToArray function but I get the same error. I sense it may still be in the file format perhaps. Here is a link to download the actual file which may help: Google Drive: Sign-in

Thanks again for jumping into this!

 

[mmhill]

I got your data file. There were 2 problems.. First, you never said there was a blank record at the top of the file or there was a record of field names. Details matter. Next time, put information like that in your post. Second, while it is a tab deliminated as I suspected, one of the tabs (the one after column 6 with the single alphabet character) refused to be recognized as a deliminator. I found a way around it.

This is the code in its entirety. It works on all the test files I have. Note that in the last test file, every record has the same numbers in columns 2 and 6.

Sub TableMagic()
Dim strTextFile$, rngOutputAnchor As Range
Dim objFSO, strData$, ayDelim, tmpData$, ayLines, ayBody(), i%, ayOutput(), ayRows(), tmp
Dim c1%, c2%, ayOutputTable
Const ForReading = 1

'------------------------------------------------------
'name of the text file
strTextFile = "C:\Users\barneyrubble\Downloads\@TEST\TEST_DATA.txt"
'top left cell of your output table
Set rngOutputAnchor = ThisWorkbook.Worksheets("TESTTABLE").Range("$B$28")
'------------------------------------------------------

'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile, ForReading).ReadAll
'let function pick a deliminator
ayDelim = pfChooseDeliminator(strData)

'create a body array
ayBody = pfStringToArray(strData, ayDelim(1))

ReDim ayOutput(1 To 12, 1 To 1)
ReDim ayRows(1 To 12)

'convery array to output table
For i = 0 To UBound(ayBody)

    'first output column is a function of ayBody (1) and (5)
    c1 = ((ayBody(i)(1) - 1) * 4) + ((ayBody(i)(5) - 1) * 2) + 1
    c2 = c1 + 1
    
    ayRows(c1) = ayRows(c1) + 1: ayRows(c2) = ayRows(c2) + 1
    If UBound(ayOutput, 2) < ayRows(c1) Then ReDim Preserve ayOutput(1 To 12, 1 To ayRows(c1))
    
    ayOutput(c1, ayRows(c1)) = ayBody(i)(8)
    ayOutput(c1 + 1, ayRows(c1)) = ayBody(i)(10)
    
Next i
    'transpose to get into right orientation and write to the spreadsheet
    ayOutputTable = Application.WorksheetFunction.Transpose(ayOutput)
    rngOutputAnchor.Resize(UBound(ayOutputTable, 1), 12) = ayOutputTable
    
'Cleanup
Set objFSO = Nothing
Set rngOutputAnchor = Nothing
Exit Sub

WriteTextFileToSpreadsheet:
    Dim r%, c%
    r = -1: c = -1
    With rngOutputAnchor
        For r = 0 To UBound(ayBody)
            For c = 0 To UBound(ayBody(r))
                .Offset(r, c) = ayBody(r)(c)
            Next c
        Next r
    End With
End Sub

Private Function pfStringToArray(ByVal strData$, ByVal strDelim) As Variant
Dim booSpace As Boolean, ayData, ayBody(), i%, lenStart%, lenEnd%, tmp

    'test for space deliminated (vs tab deliminated)
    booSpace = (Len(strData) - Len(Replace(strData, vbTab, ""))) = 0
    
    'create ayData to read and ayBody to write
    ayData = Split(strData, vbCrLf)
    ReDim ayBody(0 To 0)
    
    'create a deliminated array for each ayData line
    For i = 0 To UBound(ayData)
    
        'skip records that have no data or start wiht text (i.e., are the fields row)
        If Len(ayData(i)) > 0 And IsNumeric(Left(ayData(i), 1)) Then
            
            If booSpace Then 'get rid of all excess spaces & convert to vbTab deliminatd
                Do
                    lenStart = Len(ayData(i))
                    ayData(i) = Replace(ayData(i), "  ", " ")
                    lenEnd = Len(ayData(i))
                Loop Until lenStart = lenEnd
                ayData(i) = Replace(ayData(i), " ", vbTab)
            End If
            'switch tab deliminator to strdelim (one of the tabs was refusing to be recognized)
            ayData(i) = Replace(Trim(ayData(i)), vbTab, strDelim, 1, , vbBinaryCompare)
            'trim the excess deliminator if one exists
            If Right(ayData(i), 1) = strDelim Then ayData(i) = Left(ayData(i), Len(ayData(i)) - 1)
    
            'look to see if there are 10 fields as expected.  adds fields after field 7 if we are short.
            tmp = 10 - (Len(ayData(i)) - Len(Replace(ayData(i), strDelim, "")))
            ayData(i) = Application.WorksheetFunction.Substitute(ayData(i), strDelim, String(1 + tmp, strDelim), 7)
    
            'write ayData(i) to last ayBody record and then expand ayBody for next record
            ayBody(UBound(ayBody)) = Split(ayData(i), strDelim, , vbBinaryCompare)
            ReDim Preserve ayBody(0 To UBound(ayBody) + 1)
        
        End If
        
    Next i
    
    'trim last enpty record and set function to this value
    ReDim Preserve ayBody(0 To UBound(ayBody) - 1)
    pfStringToArray = ayBody

End Function

Private Function pfChooseDeliminator(strSubject) As Variant
'string of shoices for a deliminator to use; infrequently used prinatable characters
Const strChoices = "•|…—¦‡»×©Ø@–¤¬·§«ø~¥Þ=\/$%+:›&!ƒ°"
Dim i%, strD$
    For i = 1 To Len(strChoices)
        strD = Mid(strChoices, i, 1)
        'if the proposed deliminstor character is not in the string, then use that one as deliminator
        'set first array value to true to signal we fond a deliminator
        If Len(Replace(strSubject, strD, "")) = Len(strSubject) Then pfChooseDeliminator = Array(True, strD): Exit Function
    Next i
    'if ALL characters fail, we say so ... first in array is false ... and use Tab
    pfChooseDeliminator = Array(False, vbTab)
End Function