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

M

maudedog

New Member
Joined
Feb 8, 2009
Messages
17
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.
 

Attachments

  • TXT File.png
    TXT File.png
    75.3 KB · Views: 20
  • Excel File.png
    Excel File.png
    133.1 KB · Views: 18
Sort by date Sort by votes
jdellasala said:
Can you please add headers to the text file table? Can't tell what column relates to the final output.
Click to expand...
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
1col_1
timer_data


Sample workbook.xlsx
O
6
Sheet1
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
maudedog said:
Hmm, I thought I did use XL2BB but here is a link to download both files: Google Drive: Sign-in
Click to expand...
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!
 
Upvote 0
jdellasala said:
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!
Click to expand...
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
ABCDEFGHIJKLMNOPQR
11/11/21/32/12/22/33/13/23/3
25410:30:452910:35:169110:37:453810:32:308110:35:473610:38:2110:33:4010:37:0910:38:42
34210:31:268010:35:479510:37:453910:32:304510:36:423010:38:2810:34:3310:37:423710:38:54
Sheet1


timer_data.txt
ABCDEFGHIJK
1col_1col_2col_3col_4col_5col_6col_7col_8col_9col_10col_11
2012001b545400:44.810:30:45
3013001b424201:25.310:31:26
4024001b383802:28.810:32:30
5025001b393902:30.610:32:30
6036001b03:39.510:33:40
7037001b04:31.210:34:33
8018002b292905:15.310:35:16
9019002b808005:46.010:35:47
100210002b818105:47.110:35:47
110211002b454506:41.210:36:42
120312002b07:07.210:37:09
130313002b07:40.710:37:42
140114003b919107:43.310:37:45
150115003b959507:44.710:37:45
160216003b363608:21.310:38:21
170217003b303008:26.610:38:28
180318003b08:41.610:38:42
190319003b373708:54.610:38:54
timer_data
 
Upvote 0
maudedog said:
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
ABCDEFGHIJKLMNOPQR
11/11/21/32/12/22/33/13/23/3
25410:30:452910:35:169110:37:453810:32:308110:35:473610:38:2110:33:4010:37:0910:38:42
34210:31:268010:35:479510:37:453910:32:304510:36:423010:38:2810:34:3310:37:423710:38:54
Sheet1


timer_data.txt
ABCDEFGHIJK
1col_1col_2col_3col_4col_5col_6col_7col_8col_9col_10col_11
2012001b545400:44.810:30:45
3013001b424201:25.310:31:26
4024001b383802:28.810:32:30
5025001b393902:30.610:32:30
6036001b03:39.510:33:40
7037001b04:31.210:34:33
8018002b292905:15.310:35:16
9019002b808005:46.010:35:47
100210002b818105:47.110:35:47
110211002b454506:41.210:36:42
120312002b07:07.210:37:09
130313002b07:40.710:37:42
140114003b919107:43.310:37:45
150115003b959507:44.710:37:45
160216003b363608:21.310:38:21
170217003b303008:26.610:38:28
180318003b08:41.610:38:42
190319003b373708:54.610:38:54
timer_data
Click to expand...
I'm out.
 
Upvote 0
maudedog said:
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?
Click to expand...



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.

VBA Code: 
        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

VBA 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
 
Upvote 0
mmhill said:
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.

VBA Code: 
        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

VBA 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
Click to expand...
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!
 

Attachments

  • Error.PNG
    Error.PNG
    12.9 KB · Views: 4
Upvote 0
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.

VBA Code: 
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
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Populate Remarks Based on Criteria
Replies
3
Views
79
Sergius
S
A
  • Question Question
How to populate daily sales dynamically based on the week-ending dates and daily % breakdown
Replies
0
Views
268
Adit
A
C
  • Solved
User Select PDF import to specific Excel sheet
2 3 4
Replies
31
Views
1K
John_w
J
S
  • Question Question
Need to remove Arrow againts -,* and #value
Replies
9
Views
129
sksanjeev786
S
W
  • Question Question
Data lookup based upon date range
Replies
2
Views
125
bebo021999
B

Forum statistics

Threads
1,224,823
Messages
6,181,178
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top