Searching multiple occurence of same keyword from text file and saving its output in different Excel worksheets

[indiansth]

Hello Experts,
I am in need of a VBA script for doing mentioned task: 1.Searching multiple occurence of same keyword from the text file 2.Copy keyword line till end of the line of each occurence and paste in different worksheets for different occurences 3.Performs the "Text to Columns" operation using a semi-colon delimiter in all worksheets 4.Save the modified Excel file
Example:
Animals: Lion Tiger Zebra
Animals: Fast Aggressive No Horns
I want to search every occurence of word "Animals" in the text sheet, and paste each occurence till end of its line in different tabs of worksheet.

 

[myall_blues]

Will the keyword always be at the beginning of the line?
Can the keyword occur more than once in a single line?

 

[indiansth]

Will the keyword always be at the beginning of the line?
Can the keyword occur more than once in a single line?

Thank you, myall_blues for the prompt response.

Will the keyword always be at the beginning of the line? >>> Yes
Can the keyword occur more than once in a single line? >> No

 

[myall_blues]

Try this.

Note this uses the FSO library. You will need to add a reference to it in VBA. To do this, in the VB Editor, select Tools | References, make sure 'Microsoft Scripting Runtime' is checked and click OK.

Sub indiansth()
    Dim StrLine As String, sString As String
    Dim FSO As New FileSystemObject
    Dim TSO As Object
    Dim StrLineElements As Variant
    Dim Index As Long
    Dim i As Long
    Dim Delimiter As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TSO = FSO.OpenTextFile("C:\Temp\indiansth.txt")
    Delimiter = ":"
    Index = 1
    sString = InputBox( _
      Prompt:="Enter Search String" & vbCrLf, _
      Title:="Search String")
    If sString = "" Then
        Exit Sub
    End If
    Do While TSO.AtEndOfStream = False
       StrLine = TSO.ReadLine
       If InStr(StrLine, sString, vbBinaryCompare) <> 0 Then ' Case sensitive search; use vbTextCompare for not case sensitive)
            StrLineElements = Split(StrLine, Delimiter)
            Sheets.Add After:=Sheets(Sheets.Count)
            For i = LBound(StrLineElements) To UBound(StrLineElements)
                Sheets(ActiveSheet.Name).Cells(1, i + 1).Value = StrLineElements(i)
            Next i
            Index = Index + 1
        End If
    Loop
    TSO.Close
End Sub

 

[indiansth]

Try this.

Note this uses the FSO library. You will need to add a reference to it in VBA. To do this, in the VB Editor, select Tools | References, make sure 'Microsoft Scripting Runtime' is checked and click OK.

Sub indiansth()
    Dim StrLine As String, sString As String
    Dim FSO As New FileSystemObject
    Dim TSO As Object
    Dim StrLineElements As Variant
    Dim Index As Long
    Dim i As Long
    Dim Delimiter As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TSO = FSO.OpenTextFile("C:\Temp\indiansth.txt")
    Delimiter = ":"
    Index = 1
    sString = InputBox( _
      Prompt:="Enter Search String" & vbCrLf, _
      Title:="Search String")
    If sString = "" Then
        Exit Sub
    End If
    Do While TSO.AtEndOfStream = False
       StrLine = TSO.ReadLine
       If InStr(StrLine, sString, vbBinaryCompare) <> 0 Then ' Case sensitive search; use vbTextCompare for not case sensitive)
            StrLineElements = Split(StrLine, Delimiter)
            Sheets.Add After:=Sheets(Sheets.Count)
            For i = LBound(StrLineElements) To UBound(StrLineElements)
                Sheets(ActiveSheet.Name).Cells(1, i + 1).Value = StrLineElements(i)
            Next i
            Index = Index + 1
        End If
    Loop
    TSO.Close
End Sub

Thank you once again, Mate. But, i am getting this error while execution.

 

[myall_blues]

Note the first part of my reply

“Note this uses the FSO library. You will need to add a reference to it in VBA. To do this, in the VB Editor, select Tools | References, make sure 'Microsoft Scripting Runtime' is checked and click OK.”