Thread: Copy text file after "phrase" in the text

G'day
I have a text file that I need to import into Excel. The file is generally about 100,000 lines but I only need the data after the phrase "Adjusted Coordinates". The location of the phrase changes within the text file as more data is added from the program that created it. It is unfortunately not a unique phrase as it is repeated a second time 3 lines later.

I have had a crack at getting this to work but I currently have to manually delete all of the data above "Adjusted Coordinates" and then import it (see below).

I would prefer if the required data can just be extracted from the text file without altering the original file.

Attached is an example of the text file. I have taken a lot of the data out of it to make it a smaller file but I think the same principle should apply.

Thanks in advance

Sub Import_old()

'Opens the the Dialog box to select the file
    Dim lCount As Long
    Dim GetFile As String
    With Application.FileDialog(msoFileDialogOpen)
        .Show
        For lCount = 1 To .SelectedItems.Count
            GetFile = .SelectedItems(lCount)
        Next lCount
    End With
    
'Inserts the selected file into excel
    Dim strFile As String
    strFile = GetFile
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & GetFile, _
        Destination:=Range("A1"))
        .Name = GetFile
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("E5:P5").Select
    Selection.Cut Destination:=Range("F5:Q5")
    Range("F5:Q5").Select
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("D4:H4").Select
    Selection.ClearContents
End Sub

Hi fredo,
or maybe something like

Option Explicit
Sub FilterFileTwo()
    On Error Resume Next
   Dim XBoolean As Boolean
   Dim data As String
   Dim xRow As Long
    XBoolean = False
    Open ThisWorkbook.Path & "\Example.txt" For Input As #1
    If Err <> 0 Then
        MsgBox "Error reading or writing a file."
        Exit Sub
    End If
    Do While Not EOF(1)
        Line Input #1, data
        If InStr(1, data, "Adjusted Coordinates") Then XBoolean = True
        If InStr(1, data, "---") Then XBoolean = False
        If XBoolean Then
         xRow = xRow + 1
         Cells(xRow, 1) = data
        End If
    Loop
 Close #1
Call MacroTexttoCloumn
End Sub
Sub MacroTexttoCloumn()
   With Columns("A:A")
    .TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(9, 1), Array(16, 1), Array(27, 1), Array(40, 1), _
        Array(43, 1), Array(54, 1), Array(69, 1), Array(83, 1), Array(88, 1), Array(95, 1), Array( _
        104, 1), Array(109, 1), Array(115, 1), Array(122, 1), Array(129, 1), Array(136, 1)), _
        TrailingMinusNumbers:=True
   End With
End Sub