Copying data from text file(which is in a specific pattern extracted from PDF file)

Question

Need support on copying data from Text file to excel sheet1. In text file data is in specific pattern and want to extract some data from it to excel. what is required result is manually added in attached photo. text file photo is also attached for reference. Since its a large data and cannot be copied manually, need a VBA solution to it please.

Link to the files: Data files

i have tried this code but it brings complete data.

Sub CopyDataFromTextFile()
    Dim FilePath As String
    Dim DataPattern As String
    Dim DataArray() As String
    Dim i As Long
    Dim LastRow As Long
    Dim ws As Worksheet
    Dim CopyLine As Boolean
    
    ' Set the file path of the text file
    FilePath = "C:\Users\engr_\Desktop\Data4.txt"
    
    ' Set the data pattern to look for
    DataPattern = "ETHERCAT NETWORK|CAVO ETHERNET CAT6A 10 GBIT RJ45/RJ45|2549850282|1|TO BE ADDED\TO BE REMOVED"
    
    ' Split the data pattern into an array
    DataArray = Split(DataPattern, "|")
    
    ' Set the worksheet to paste the data into
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change the sheet name as needed
    
    ' Open the text file for reading
    Open FilePath For Input As #1
    
    ' Initialize variables
    LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row + 1
    CopyLine = False
    
    ' Loop through the text file
    Do While Not EOF(1)
        Dim Line As String
        Line Input #1, Line
        ' Check if the line matches the data pattern
        For i = LBound(DataArray) To UBound(DataArray)
            If InStr(1, Line, DataArray(i), vbTextCompare) > 0 Then
                CopyLine = True
                Exit For
            End If
        Next i
        ' If CopyLine is True, copy the line to the worksheet
        If CopyLine Then
            ws.Cells(LastRow, 2).Value = Line
            LastRow = LastRow + 1
        End If
    Loop
    
    ' Close the text file
    Close #1
End Sub

Answer 1

The data in the text file is not structured as a well-organized table, making it challenging to determine how to split each line.

Note: : Please review the TECHNICAL DESCRIPTION section in the output, as it may require fine-tuning.

Option Explicit

Sub Deomo()
    Dim FilePath As String
    Dim csvWK As Workbook, csvSht As Worksheet
    Dim arrData, arrRes(), sKey
    Dim i As Long, j As Long
    Const KEY1 = "TO BE ADDE"
    Const KEY2 = "TO BE REMO"
    Application.ScreenUpdating = False
    FilePath = "d:\TEMP\Data4.txt" ' Modify as needed
    ' Split by widht
    Workbooks.OpenText Filename:=FilePath, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(10, 1), Array(56, 1), _
        Array(100, 1), Array(110, 1), Array(128, 1))
    Set csvWK = ActiveWorkbook
    ' Load data
    With csvWK.ActiveSheet
        arrData = .UsedRange.Value
    End With
    csvWK.Close False
    ReDim arrRes(1 To 5, 1 To UBound(arrData))
    j = 1
    ' Populate header
    For Each sKey In Split("DESCRIPTION|TECHNICAL DESCRIPTION|PARTS CODE|QTY|TO BE ADDED/REMOVED", "|")
        arrRes(j, 1) = sKey
        j = j + 1
    Next sKey
    j = 1
    For i = LBound(arrData) To UBound(arrData)
        sKey = Trim(arrData(i, 4))
        ' Matching keyword
        If sKey = KEY1 Or sKey = KEY2 Then
            j = j + 1
            ' TO BE ADDED/REMOVED
            arrRes(5, j) = sKey & IIf(sKey = KEY1, "D", "VED")
            ' QTY
            arrRes(4, j) = arrData(i - 1, 6)
            ' PARTS CODE
            arrRes(3, j) = "'" & Trim(arrData(i - 1, 5))
            ' TECHNICAL DESCRIPTION
            arrRes(2, j) = arrData(i - 1, 3) & arrData(i - 1, 4)
            ' DESCRIPTION
            arrRes(1, j) = arrData(i, 2)
        End If
    Next i
    ReDim Preserve arrRes(1 To 5, 1 To j)
    ' Write data to work sheet
    With ActiveSheet
        .Cells.Clear
        .Range("A1").Resize(j, 5).Value = Application.Transpose(arrRes)
        .Columns("A:E").AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

Microsoft documentation:

Workbooks.OpenText method (Excel)