VBA needed to extract specific info from txt file to excel

[ramuk8891]

Hi,

I'm very new to excel and vba so I apologize in advance if this is a very elementary task. I'm trying to automate something for our team where we only need to extract certain data (Buyer Part, Price, Effective Date). However, we only need this data if it comes after a line break saying "Line item change Add Additional Item". There is a lot more data in the txt file but I only really need these points of data after 'Add Additional Item'.

It is formatted like this in the txt file attached:

************************ LINE ITEM CHANGE ******************************
******************* Add Additional Item *************************

LINE ITEM #: 00310
QUANTITY: 0
MEASUREMENT: EA
PRICE: 53.65(Price per Hundred)
BUYER PART: 06510669AA
DRAWING LETTER: 06510669AA
DCL LATEST CODE: C
DESCRIPTION: SC/HEX.FLG.HD-HEADER.PT.REDUCD.BDY.SPECI

Product Change Notice Number: F101US2007
Model year number: 2022
Model year number: 2018
Model year number: 2016
Model year number: 2020
Model year number: 2021
Model year number: 2015
Model year number: 2019
Model year number: 2017
Model year number: 2023

Effective: 20200701

I have also attached what the output in excel would ideally look like. Any help is here is greatly appreciated

excel 2016 windows 365

Thank you!

 

[Marc L]

Hi,​

​

according to forum rules - in fact whatever the forum ! - you do not need to create any duplicate thread.​

The duplicate in the Excel formulas section is now removed …​

​

 

[mohadin]

Hi
Its late but any way try this code

Sub test()
    Dim a As Variant
    Dim fn, My_Text As String
    Dim i As Long
    Dim m, k
    fn = Application.GetOpenFilename("textFiles,*.txt")
    If fn = "False" Then Exit Sub
    My_Text = CreateObject("Scripting.FileSystemObject").OpenTextFile(fn).ReadAll
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\Add Additional Item)|(\PRICE:.+)|(\BUYER PART: .+)|(\Effective:.+)"
        Set m = .Execute(My_Text)
        ReDim a(1 To m.Count, 1 To 4)
        For i = 0 To m.Count - 1
            If m(i) = "Add Additional Item" Then
                a(k + 1, 1) = m(i)
                a(k + 1, 2) = m(i + 1)
                a(k + 1, 3) = m(i + 2)
                a(k + 1, 4) = m(i + 3)
                k = k + 1
            End If
        Next
    End With
    Cells(1, 1).Resize(, 4) = Array("Change", "Buyer Part", "Price", "Effective Date")
    Cells(2, 1).Resize(k, UBound(a, 2)) = a
End Sub