Import Data from Text FIle if it contains certain words

[Mr_Stu]

Hi,

I have searched the forum for an answer to this but can not find one. Please excuse me if I have missed something obvious. any help would be appreciated.

I have a TXT File that contains many lines of data. I would like to be able to import lines if they contain certain string values. The string values could appear in any position in the line.

As an example if a line contains Apple, Grapes and Peach then the line is added to the Worksheet and moves to check the next line in the TXT file for the same, repeating until the end. Lines that do not contain all these words should not be added.

Apple|Bannana|Grapes|Orange|Strawberry|Pear|Peach Added

Apple|Bannana|Grapes|Orange|Strawberry|Pear|Melon Not added

 

[Domenic]

Try the following macro, which should be placed in a regular module (Visual Basic Editor >> Insert >> Module). The macro uses the Open statement to get the entire data into a string, and then it splits the data into lines and transfers them to an array. Then it loops through each line in the array, and then transfers any line that meets the criteria to another array. Then it transfers the results from the array to a newly added worksheet in the active workbook. And then it splits the resulting column into multiple columns.

Note that you'll need to make changes to the code where specified. Also, I have made a number of assumptions since you haven't provided us with a lot of detail. So we will likely need to make some changes to the code depending on your actual requirements.

'force the explicit declaration of variables
Option Explicit

Sub ImportFromFile()

    'get the source folder name (change accordingly)
    Dim sourceFolderName As String
    sourceFolderName = "C:\Users\Domenic\Desktop\"
    If Right(sourceFolderName, 1) <> "\" Then
        sourceFolderName = sourceFolderName & "\"
    End If
  
    'make sure source folder exists
    If Len(Dir(sourceFolderName, vbDirectory)) = 0 Then
        MsgBox "'" & sourceFolderName & "' not found!", vbExclamation
        Exit Sub
    End If
  
    'get the source file name (change accordingly)
    Dim sourceFileName As String
    sourceFileName = "sample2.txt"
  
    'make sure file exists in specified folder
    If Len(Dir(sourceFolderName & sourceFileName, vbNormal)) = 0 Then
        MsgBox "'" & sourceFolderName & sourceFileName & "' not found!", vbExclamation
        Exit Sub
    End If
  
    'get the entire data from file
    Dim data As String
    Dim fileNumber As Long
    fileNumber = FreeFile()
    Open sourceFolderName & sourceFileName For Input As #fileNumber
        data = Input(LOF(fileNumber), fileNumber)
    Close #fileNumber
  
    'split the data into lines and assign them to lines()
    Dim lines() As String
    lines() = Split(data, vbCrLf)
  
    'make sure file contained data
    If UBound(lines) = -1 Then
        MsgBox "No data found in file!", vbExclamation
        Exit Sub
    End If
  
    'loop through lines() and fill results() with lines that meet the criteria
    ReDim results(UBound(lines)) As String
    Dim resultsCount As Long
    Dim line As String
    Dim i As Long
    resultsCount = 0
    For i = LBound(lines) To UBound(lines)
        line = lines(i)
        If InStr(1, line, "Apple", vbTextCompare) Then
            If InStr(1, line, "Grapes", vbTextCompare) Then
                If InStr(1, line, "Peach", vbTextCompare) Then
                    results(resultsCount) = line
                    resultsCount = resultsCount + 1
                End If
            End If
        End If
    Next i
  
    If resultsCount > 0 Then
        'add new worksheet to active workbook
        Worksheets.Add
        'transfer the results from results() to this worksheet
        Range("a1").Resize(UBound(results) + 1).Value = Application.Transpose(results)
        'split the column into multiple columns
        Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row).TextToColumns _
            Destination:=Range("a1"), _
            DataType:=xlDelimited, _
            Other:=True, _
            OtherChar:="|"[URL='https://www.mrexcel.com/board/threads/import-data-from-text-file-if-it-contains-certain-words.1131500/#top']Top[/URL]
    Else
        MsgBox "No lines found!", vbExclamation
    End If
  
End Sub

Hope this helps!

 

[Mr_Stu]

Hi Domenic,

Thank you for the quick response and help. I am really impressed this worked perfectly first time and is exactly what I needed.

This has helped me a great deal and I am very grateful. Thank you once again.

 

[Domenic]

That's great, and thanks for your feedback, cheers!

 

[aks24]

Try the following macro, which should be placed in a regular module (Visual Basic Editor >> Insert >> Module). The macro uses the Open statement to get the entire data into a string, and then it splits the data into lines and transfers them to an array. Then it loops through each line in the array, and then transfers any line that meets the criteria to another array. Then it transfers the results from the array to a newly added worksheet in the active workbook. And then it splits the resulting column into multiple columns.

Note that you'll need to make changes to the code where specified. Also, I have made a number of assumptions since you haven't provided us with a lot of detail. So we will likely need to make some changes to the code depending on your actual requirements.

'force the explicit declaration of variables
Option Explicit

Sub ImportFromFile()

    'get the source folder name (change accordingly)
    Dim sourceFolderName As String
    sourceFolderName = "C:\Users\Domenic\Desktop\"
    If Right(sourceFolderName, 1) <> "\" Then
        sourceFolderName = sourceFolderName & "\"
    End If
 
    'make sure source folder exists
    If Len(Dir(sourceFolderName, vbDirectory)) = 0 Then
        MsgBox "'" & sourceFolderName & "' not found!", vbExclamation
        Exit Sub
    End If
 
    'get the source file name (change accordingly)
    Dim sourceFileName As String
    sourceFileName = "sample2.txt"
 
    'make sure file exists in specified folder
    If Len(Dir(sourceFolderName & sourceFileName, vbNormal)) = 0 Then
        MsgBox "'" & sourceFolderName & sourceFileName & "' not found!", vbExclamation
        Exit Sub
    End If
 
    'get the entire data from file
    Dim data As String
    Dim fileNumber As Long
    fileNumber = FreeFile()
    Open sourceFolderName & sourceFileName For Input As #fileNumber
        data = Input(LOF(fileNumber), fileNumber)
    Close #fileNumber
 
    'split the data into lines and assign them to lines()
    Dim lines() As String
    lines() = Split(data, vbCrLf)
 
    'make sure file contained data
    If UBound(lines) = -1 Then
        MsgBox "No data found in file!", vbExclamation
        Exit Sub
    End If
 
    'loop through lines() and fill results() with lines that meet the criteria
    ReDim results(UBound(lines)) As String
    Dim resultsCount As Long
    Dim line As String
    Dim i As Long
    resultsCount = 0
    For i = LBound(lines) To UBound(lines)
        line = lines(i)
        If InStr(1, line, "Apple", vbTextCompare) Then
            If InStr(1, line, "Grapes", vbTextCompare) Then
                If InStr(1, line, "Peach", vbTextCompare) Then
                    results(resultsCount) = line
                    resultsCount = resultsCount + 1
                End If
            End If
        End If
    Next i
 
    If resultsCount > 0 Then
        'add new worksheet to active workbook
        Worksheets.Add
        'transfer the results from results() to this worksheet
        Range("a1").Resize(UBound(results) + 1).Value = Application.Transpose(results)
        'split the column into multiple columns
        Range("a1:a" & Cells(Rows.Count, "a").End(xlUp).Row).TextToColumns _
            Destination:=Range("a1"), _
            DataType:=xlDelimited, _
            Other:=True, _
            OtherChar:="|"[URL='https://www.mrexcel.com/board/threads/import-data-from-text-file-if-it-contains-certain-words.1131500/#top']Top[/URL]
    Else
        MsgBox "No lines found!", vbExclamation
    End If
 
End Sub

Hope this helps!

Hi Domenic,

Can you please answer my query as well, it is similar kind of query,

If we take same example then :

I want to import 7 characters after every time the word "Apple" comes, in 1st column of excel sheet and 11 characters after every time the word "Orange" comes, but in 2nd column of excel sheet.

Lets say in my sample text file "Apple" comes 10 times so i need values in 10 cells of 1st column in the same order... I. E starting to end

And similarly if "Orange" also comes 10 times, then i need values in 10 cells of 2nd column in excel in the same order.... I. E starting to end...