Search in TXT file and return line to Excel

J

jphumani

New Member
Joined
Jan 21, 2019
Messages
18
Hi there to evereybody!

Im Juan and i'm writing from argentina.

I have a TXT file with millons o lines (literally) like this:

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]22082019;01092019;30092019;20000163989;D;S;N;0,00;0,00;00;00;ETCHEVERRIGARAY JUAN CARLOS

I would like to use a command button to search for the number i've marked with bold. In addition i'd like to recieve the entire line in Excel.

Basically each line contains some tax info for argentinian members.

I've seacher the web and tried something like this:

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]Function buscar()
Open "D:\caba.txt" For Input As #1
Do While Not EOF(1)
Line Input #1 , dato
If dato = UserForm1.TextBox1 Then
Range("b3").Value = UserForm1.TextBox1
Range("c3").Value = dato
End Function

Wish you can help me.

Thanks in advantage

Juan Pablo
[/FONT]<strike>
</strike>[/FONT]
 
Sort by date Sort by votes
I figured out another approach. First try it out with a small set of your data. About 15 identification numbers in column A, and keep your file with the one million lines small. Start with 100 lines to test. Otherwise Excel can freeze.

Code: 
Option Explicit

Public Function QuickRead(FName As String) As Variant
    Dim i As Integer
    Dim res As String
    Dim l As Long
    Dim v As Variant

    i = FreeFile
    l = FileLen(FName)
    res = Space(l)
    Open FName For Binary Access Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=i]#i[/URL] 
    Get [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=i]#i[/URL] , , res
    Close i
    
    'split the file with vbcrlf
    QuickRead = Split(res, vbCrLf)
End Function

Sub Find_Identification_Number()
    '[COLOR="#FF0000"]Replace file path/name to any file path/name you desire[/COLOR]
    Dim strFilePathName As String: strFilePathName = "[COLOR="#FF0000"]c:\temp\textfile.txt[/COLOR]"
    
    Dim strFileLine As String
    Dim myArr, v As Variant
    Dim LastRow, x, y As Long
    
    'Assume your Identification Numbers in Column A. Find last empty row.
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    'Store your Identification Numbers in Array myArr
    myArr = Application.Transpose(Sheets("Sheet1").Range("A2:A" & LastRow))
    
    'Counter for myArr
    y = 1
    
    'Read your file with the one million lines in Array v
    v = QuickRead(strFilePathName)
    
    'Process all Identification Numbers in Column A till there are no more left
    Do While y <= UBound(myArr)
        
        'Search for Identification Number in the lines from your file
        For x = 0 To UBound(v)
            If InStr(1, v(x), myArr(y)) > 0 Then
                
                'When found print to Immediate Window . . .
                Debug.Print myArr(y) & "->" & v(x)
                
                'Increase y to go to next Identification Number
                y = y + 1
                
                ' . . . and exit the for loop
                Exit For
            End If
        Next
    Loop
End Sub
 
Upvote 0

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Hello jphumani,

This problem is like the riddle "How do you eat an Elephant?". The answer: A piece at a time. The preferred method of handling large files is to do it in pieces or "chunks". A file chunk represents a range of data within a file. File chunking produces a list of chunks that are sequential and adjacent and that reference the entire contents of the file.

This macro will do just that. It will read up to 10,000 lines from the text file at a time. If there are fewer than 10,000 lines then the entire file is read. The lines are concatenated into a single string which is then searched for the word or phrase. Once found, the line of text it belongs to is extracted and returned by the macro. Because this macro is a UDF (User Defined Function) you can use this on a worksheet like a formula.

The default encoding for the text file is ASCII. If you have a text file that is "Unicode", or "UTF-8", simply add the encoding as a string to the macro call. It is the last argument.
Code: 
' Written:  October 01, 2019' Author:   Leith Ross
' Summary:  Finds a word or phrase in a text file and returns the line the text is in.
'
' NOTE:     The file name must be fully qualified, i.e. complete file path is included.


Function FindAndReadLine(ByVal FileName As String, ByVal FindText As String, Optional Encoding As String = "ASCII") As String


    Dim adoStream   As Object
    Dim cnt         As Long
    Dim eol         As Long
    Dim n           As Long
    Dim sol         As Long
    Dim Text        As String
    
    Const adTypeText    As Long = 2
    Const adReadLine    As Long = -2
            
            On Error GoTo Finished
            
            ' Default text encoding is ASCII
            
            Set adoStream = CreateObject("ADODB.Stream")
        
            With adoStream
                .Type = adTypeText
                .CharSet = Encoding
                .Open
                .LoadFromFile FileName
Search:
                ' Text read is equal to 10,000 lines each time
                ' or just the lines remaining in the file.
                While cnt < 10000 Or Not .EOS
                    Text = Text & .ReadText(adReadLine) & vbCrLf
                    cnt = cnt + 1
                Wend
            
                ' Search for the text (ignore case).
                n = InStr(1, Text, FindText, vbTextCompare)
            
                If n > 0 Then
                    ' Found it!
                    ' Find the end of the line.
                    eol = InStr(n + Len(FindText), Text, vbCrLf)
                    If eol = 0 Then eol = Len(Text)
                
                    ' Find start of the line.
                    sol = InStrRev(Text, vbCrLf, n - 1)
                    If sol = 0 Then sol = 1
                
                    ' Extract the text.
                    If eol > 0 And sol > 0 Then
                        Text = Mid(Text, sol, eol - sol)
                        GoTo Finished
                    End If
                End If
            
                ' Reset and continue searching
                If Not .EOS Then
                    cnt = 0
                    Text = ""
                    GoTo Search
                End If
            End With
        
            ' No match was found.
            Text = ""
            
Finished:
        If Err <> 0 Then
            MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf & Err.Description
        End If
        
        adoStream.Close
        
        FindAndReadLine = Text
        
End Function

Example of Calling the Macro
Code: 
Function buscar()
    dato = FindAndReadLine("D:\caba.txt", TextBox1.Text)
    If dato <> "" Then
        Range("B3").Value = UserForm1.TextBox1
        Range("C3").Value = dato
    End If
End Function
 
Last edited:
Upvote 0
First of all, as before, THANKS.

The only problema i have with your code is that i have the information in a TXT, its a line for each Tax Info of each person. And there are more tan 3 millons records

You can see a small sample on this link:

[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]https://drive.google.com/open?id=1UzRBYKUF0LFlL3ibBI723FjKdXoXIZbC
[/FONT]
Oh, i've found this:
'Requires a reference to the Microsoft Scripting Runtime.
'Tools | References -> Microsoft Scripting Runtime
Excellent!

So, is there any modification i should make because im using a TXT file?

Please have a look at the file, its small.​

strooman said:
OK, first things first. I'm not the best coder so the code below is a little bit cumbersome but I hope it get's you going.

- Open your Visual Basic Editor with the shortcut Alt+F11. When you have a laptop you probably should give the shortcut Fn+Alt+F11. The Fn button on a laptop is called the function key and is used to activate a second function on the top buttons.
- In the top menubar click Insert and then choose Module.
- Copy and Paste the VBA code wich you can find below.
- To activate the red part:

'Requires a reference to the Microsoft Scripting Runtime.
'Tools | References -> Microsoft Scripting Runtime

click in the top menubar Tools and then References. Scroll through the very long list and search for "Microsoft Scripting Runtime" check the checkbox and click OK.
- Make adjustments to the path name in this line: Set txtStream = fso.OpenTextFile("c:\temp\textfile.txt", ForReading, False). Point to the location where your text file is and you want to search.
- Return to your workbook.

Now you have to realize that we don't see your setup. How that looks like in your workbook. So we have to guess. You say: "So what i need to do is to search that identification number and calculate the exact tax for that person. Each state gives you a LARGE txt file with millons of "identification numbers".

Now let's assume that you have a bunch of your identification numbers in Column A of Sheet1 and run the code.

Excel 2016 Professional (Windows) 64 bit
[TABLE="class: head"]
<tbody>[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[TH][/TH]
[TH]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]A[/COLOR]​
[/TH]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]1[/COLOR]​
[/TD]
[TD="bgcolor: #FFFF00"]Identification_Numbers[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]2[/COLOR]​
[/TD]
[TD]
20000163989​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]3[/COLOR]​
[/TD]
[TD]
20000164626​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]4[/COLOR]​
[/TD]
[TD]
20000164625​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]5[/COLOR]​
[/TD]
[TD]
20000164840​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]6[/COLOR]​
[/TD]
[TD]
20000164161​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]7[/COLOR]​
[/TD]
[TD]
20000164087​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]8[/COLOR]​
[/TD]
[TD]
20000164187​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]9[/COLOR]​
[/TD]
[TD]
20000164197​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]10[/COLOR]​
[/TD]
[TD]
20000164667​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]11[/COLOR]​
[/TD]
[TD]
20000164263​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]12[/COLOR]​
[/TD]
[TD]
20000164913​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]13[/COLOR]​
[/TD]
[TD]
20000164521​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]14[/COLOR]​
[/TD]
[TD]
20000164541​
[/TD]
[/TR]
[TR="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] "]
[TD="bgcolor: [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=E0E0F0]#E0E0F0[/URL] "]
[COLOR=[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FFFFFF]#FFFFFF[/URL] ]15[/COLOR]​
[/TD]
[TD]
20000164762​
[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="class: grid"]
<tbody>[TR]
[TD]Sheet: Sheet1[/TD]
[/TR]
</tbody>[/TABLE]

Code: 
Option Explicit

Sub Find_20000163989()
'Requires a reference to the Microsoft Scripting Runtime.
'Tools | References -> Microsoft Scripting Runtime

Dim fso As FileSystemObject: Set fso = New FileSystemObject
Dim str_To_Find, strNextLine As String
Dim txtStream, LastRow
Dim IdNumber, rngCell As Range
 
'Assume your id numbers in Column A. Find last empty row.
LastRow = Range("A" & Rows.Count).End(xlUp).Row

'Assign Variable IdNumber to Range
Set IdNumber = Sheets("Sheet1").Range("A2:A" & LastRow - 1)

'Cycle through every cell of the Range -> IdNumber
For Each rngCell In IdNumber
    
    'Open your file with the one million lines ! ! !
    Set txtStream = fso.OpenTextFile("c:\temp\textfile.txt", ForReading, False)
    
    'Assign the value of the cell to variable str_To_Find
    str_To_Find = rngCell.Value
    
    'Loop through the lines to find the Identification Number
    'And print the line to Immediate window
    Do While Not txtStream.AtEndOfStream
        strNextLine = txtStream.ReadLine
        If InStr(1, strNextLine, str_To_Find) > 0 Then
            Debug.Print strNextLine
            
            'If Identification Number found exit the Do Loop.
            Exit Do
        End If
    Loop
    'Close the stream
    txtStream.Close
Next
End Sub
Click to expand...
 
Upvote 0
Hi Leith! Great response! Of course i understood the elephant thing haha.

Either im a Little stupid or either i couldn't make it happend.

I 've uploaded a sample of the TXT file and the Excel file with your codes. Something is wrong. Is there any chance you can have a look?

TXT FILE:
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif][FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]https://drive.google.com/open?id=13IExv1GqdYa_5YKRzswjExcY4zm3uh2v[/FONT]
EXCEL FILE:
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]https://drive.google.com/open?id=1_Kr_0wqE_HdW7-BFMGF9vk1I1aNK3Br9

Thanks again Leith[/FONT]<strike>



</strike>[/FONT]

Leith Ross said:
Hello jphumani,

This problem is like the riddle "How do you eat an Elephant?". The answer: A piece at a time. The preferred method of handling large files is to do it in pieces or "chunks". A file chunk represents a range of data within a file. File chunking produces a list of chunks that are sequential and adjacent and that reference the entire contents of the file.

This macro will do just that. It will read up to 10,000 lines from the text file at a time. If there are fewer than 10,000 lines then the entire file is read. The lines are concatenated into a single string which is then searched for the word or phrase. Once found, the line of text it belongs to is extracted and returned by the macro. Because this macro is a UDF (User Defined Function) you can use this on a worksheet like a formula.

The default encoding for the text file is ASCII. If you have a text file that is "Unicode", or "UTF-8", simply add the encoding as a string to the macro call. It is the last argument.
Code: 
' Written:  October 01, 2019' Author:   Leith Ross
' Summary:  Finds a word or phrase in a text file and returns the line the text is in.
'
' NOTE:     The file name must be fully qualified, i.e. complete file path is included.


Function FindAndReadLine(ByVal FileName As String, ByVal FindText As String, Optional Encoding As String = "ASCII") As String


    Dim adoStream   As Object
    Dim cnt         As Long
    Dim eol         As Long
    Dim n           As Long
    Dim sol         As Long
    Dim Text        As String
    
    Const adTypeText    As Long = 2
    Const adReadLine    As Long = -2
            
            On Error GoTo Finished
            
            ' Default text encoding is ASCII
            
            Set adoStream = CreateObject("ADODB.Stream")
        
            With adoStream
                .Type = adTypeText
                .CharSet = Encoding
                .Open
                .LoadFromFile FileName
Search:
                ' Text read is equal to 10,000 lines each time
                ' or just the lines remaining in the file.
                While cnt < 10000 Or Not .EOS
                    Text = Text & .ReadText(adReadLine) & vbCrLf
                    cnt = cnt + 1
                Wend
            
                ' Search for the text (ignore case).
                n = InStr(1, Text, FindText, vbTextCompare)
            
                If n > 0 Then
                    ' Found it!
                    ' Find the end of the line.
                    eol = InStr(n + Len(FindText), Text, vbCrLf)
                    If eol = 0 Then eol = Len(Text)
                
                    ' Find start of the line.
                    sol = InStrRev(Text, vbCrLf, n - 1)
                    If sol = 0 Then sol = 1
                
                    ' Extract the text.
                    If eol > 0 And sol > 0 Then
                        Text = Mid(Text, sol, eol - sol)
                        GoTo Finished
                    End If
                End If
            
                ' Reset and continue searching
                If Not .EOS Then
                    cnt = 0
                    Text = ""
                    GoTo Search
                End If
            End With
        
            ' No match was found.
            Text = ""
            
Finished:
        If Err <> 0 Then
            MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf & Err.Description
        End If
        
        adoStream.Close
        
        FindAndReadLine = Text
        
End Function

Example of Calling the Macro
Code: 
Function buscar()
    dato = FindAndReadLine("D:\caba.txt", TextBox1.Text)
    If dato <> "" Then
        Range("B3").Value = UserForm1.TextBox1
        Range("C3").Value = dato
    End If
End Function
Click to expand...
 
Upvote 0
Hello jphumani,

I downloaded both of your files. This is the code I used for the UserForm and it worked.

Code: 
Function buscar()


    Dim Archivo As String
    Dim dato    As String
    
        Archivo = "D:\cabaSAMPLE.txt"
        dato = FindAndReadLine(Archivo, TextBox1.Text)
        
        If dato <> "" Then
            Range("B3").Value = UserForm1.TextBox1
            Range("C3").Value = dato
        End If
        
End Function


Private Sub CommandButton1_Click()
    buscar
End Sub

If you receive error 3002 [FONT=&quot]File could not be opened, here are some common causes of the error: A misspelled file name was specified, or a file has been moved, renamed, or deleted. Over a network, the drive might be temporarily unavailable or network traffic might be preventing a connection.[/FONT]
 
Upvote 0
Hi Leith! allright! I've tested and...

With the sample, just fine.
With the complete file...i let it run about 1 hour and still "proccesing". So, maybe the file is to big for this code.

Could not solve it.

I wanted to let you know.

Leith Ross said:
Hello jphumani,

I downloaded both of your files. This is the code I used for the UserForm and it worked.

Code: 
Function buscar()


    Dim Archivo As String
    Dim dato    As String
    
        Archivo = "D:\cabaSAMPLE.txt"
        dato = FindAndReadLine(Archivo, TextBox1.Text)
        
        If dato <> "" Then
            Range("B3").Value = UserForm1.TextBox1
            Range("C3").Value = dato
        End If
        
End Function


Private Sub CommandButton1_Click()
    buscar
End Sub

If you receive error 3002 File could not be opened, here are some common causes of the error: A misspelled file name was specified, or a file has been moved, renamed, or deleted. Over a network, the drive might be temporarily unavailable or network traffic might be preventing a connection.
Click to expand...
 
Upvote 0
I had to make an adjustment if number was not found. Otherwise the Do While loop was infinite and Excel would hang/freeze.

I tested it with a large textfile with 500.000 lines. Took me about 5 seconds to process. Setup:
Identification Numbers in A2:A15 and one textfile with 500.000 lines.

Cave eat: pay special attention if line ending is vbLf (LineFeed) or vbCrLf (Carriage Return LineFeed). Red Part.



Code: 
Sub Read_Large_File()
    'Replace file path/name to any file path/name you desire
    Dim strFilePathName As String: strFilePathName = "c:\temp\textfile.txt"
    Dim strFileLine As String
    Dim myArr, v As Variant
    Dim LastRow, x, y As Long
    Dim blnFound As Boolean
    
    'Assume your Identification Numbers in Column A. Find last empty row.
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    'Store your Identification Numbers in Array myArr
    myArr = Application.Transpose(Sheets("Sheet1").Range("A2:A" & LastRow))
    
    'Counter for myArr
    y = 1
    
    'Read your file with the one million lines in Array v
    v = QuickRead(strFilePathName)
    
    'Process all Identification Numbers in Column A till there are no more left
    Do While y <= UBound(myArr)
        
        'Reset
        blnFound = False
        
        'Search for Identification Number in the lines from your file
        For x = 0 To UBound(v)
            If InStr(1, v(x), myArr(y)) > 0 Then
                
                'When found print to Immediate Window . . .
                Debug.Print myArr(y) & "->" & v(x)
                
                'Increase y to go to next Identification Number
                y = y + 1
                
                'Number found
                blnFound = True
                
                ' . . . and exit the for loop
                Exit For
            End If
        Next
        If blnFound = False Then
             
             'Number not found
             MsgBox ("Number" & myArr(y) & "not found")
            
            'Increase y to go to next Identification Number
            y = y + 1
            
        End If
    Loop
End Sub

Code: 
Public Function QuickRead(FName As String) As Variant
    Dim i As Integer
    Dim res As String
    Dim l As Long
    Dim v As Variant

    i = FreeFile
    l = FileLen(FName)
    res = Space(l)
    Open FName For Binary Access Read As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=i]#i[/URL] 
    Get [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=i]#i[/URL] , , res
    Close i
    
    'split the file with [COLOR="#FF0000"]vbCrLf[/COLOR]
    QuickRead = Split(res, [COLOR="#FF0000"]vbCrLf[/COLOR]) 'adjust to fit your needs: vbLf Or vbCrLf
End Function
 
Last edited:
Upvote 0
Hi there Strooman!

Ok, im not that intelligent...

You put me 2 codes. Where should i paste that? As a module? or in ThisWorkBook?

With this kind of code i wont use the "search button"?

strooman said:
I had to make an adjustment if number was not found. Otherwise the Do While loop was infinite and Excel would hang/freeze.

I tested it with a large textfile with 500.000 lines. Took me about 5 seconds to process. Setup:
Identification Numbers in A2:A15 and one textfile with 500.000 lines.

Cave eat: pay special attention if line ending is vbLf (LineFeed) or vbCrLf (Carriage Return LineFeed). Red Part.



Code: 
Sub Read_Large_File()
    'Replace file path/name to any file path/name you desire
    Dim strFilePathName As String: strFilePathName = "c:\temp\textfile.txt"
    Dim strFileLine As String
    Dim myArr, v As Variant
    Dim LastRow, x, y As Long
    Dim blnFound As Boolean
    
    'Assume your Identification Numbers in Column A. Find last empty row.
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    'Store your Identification Numbers in Array myArr
    myArr = Application.Transpose(Sheets("Sheet1").Range("A2:A" & LastRow))
    
    'Counter for myArr
    y = 1
    
    'Read your file with the one million lines in Array v
    v = QuickRead(strFilePathName)
    
    'Process all Identification Numbers in Column A till there are no more left
    Do While y <= UBound(myArr)
        
        'Reset
        blnFound = False
        
        'Search for Identification Number in the lines from your file
        For x = 0 To UBound(v)
            If InStr(1, v(x), myArr(y)) > 0 Then
                
                'When found print to Immediate Window . . .
                Debug.Print myArr(y) & "->" & v(x)
                
                'Increase y to go to next Identification Number
                y = y + 1
                
                'Number found
                blnFound = True
                
                ' . . . and exit the for loop
                Exit For
            End If
        Next
        If blnFound = False Then
             
             'Number not found
             MsgBox ("Number" & myArr(y) & "not found")
            
            'Increase y to go to next Identification Number
            y = y + 1
            
        End If
    Loop
End Sub

Code: 
Public Function QuickRead(FName As String) As Variant
    Dim i As Integer
    Dim res As String
    Dim l As Long
    Dim v As Variant

    i = FreeFile
    l = FileLen(FName)
    res = Space(l)
    Open FName For Binary Access Read As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=i"]#i[/URL] 
    Get [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=i"]#i[/URL] , , res
    Close i
    
    'split the file with [COLOR=#ff0000]vbCrLf[/COLOR]
    QuickRead = Split(res, [COLOR=#ff0000]vbCrLf[/COLOR]) 'adjust to fit your needs: vbLf Or vbCrLf
End Function
Click to expand...
 
Upvote 0
Here is a function that I think should work (I did not download your file so I don't have a feel for how long it will take). Pass into the function the entire path to your text file and the value you want to find and it will return the entire line of text that value is on...
Code: 
Function GetEntireLine(FullPath As String, GetWhat As String) As String
  Dim FileNum As Long, Position As Long
  Dim TotalFile As String
  FileNum = FreeFile
  Open FullPath For Binary As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] 
    TotalFile = Space(LOF(FileNum))
    Get [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , , TotalFile
  Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] 
  TotalFile = vbNewLine & TotalFile & vbNewLine
  Position = InStr(TotalFile, GetWhat)
  GetEntireLine = Mid(TotalFile, InStrRev(TotalFile, vbNewLine, Position) + 1, InStr(Position, TotalFile, vbNewLine) - InStrRev(TotalFile, vbNewLine, Position))
End Function
 
Upvote 0
jphumani said:
You put me 2 codes. Where should i paste that? As a module? or in ThisWorkBook?
Click to expand...

You can paste both macro's in a standard module.

jphumani said:
With this kind of code i wont use the "search button"?
Click to expand...

This is correct. I didn't implement a search button. Just put some Identification Numbers in column A (starting in A2) and adjust the file path and point to your file with all those lines you want to search. The result will be printed to the Immediate window of the Visual Basic Editor. This is just a basic setup to see if everything is working correctly.
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question Question
VBA: open and copy data from multiple (txt. files) to excel
Replies
1
Views
505
NdNoviceHlp
NdNoviceHlp
J
  • Solved
Excel vba: Browse to text file and split at each ~ on new row
Replies
3
Views
528
JEC
JEC
F
  • Question Question
How to find an exact number match in a text file?
Replies
9
Views
1K
frankT68
F
F
  • Solved
Extract specific lines from a TXT file to an Excel Sheet
Replies
2
Views
4K
frerofrero
F
A
  • Question Question
Search for text in txt file and copy the words to excel sheet
Replies
4
Views
805
aejaz7
A

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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