How to extract data from the text file

[undercrisis01]

Hello,

I really find this site informative and helpful to people who had lesser skills with regards to excel such as myself. I am knocking once again to ask for some assistance.

I have a text file that contains a huge amount of data but i only need some parts of it. currently im doing it manually by searching for the keyword, highlight on the needed information, copy-paste to another text file and save in excel as delimited.

The data looks like this:

A 1 1213A45-1 Button part 3 pcs
AB Designer A348
A 2 GH23L-5 Illinois middle 0.5 g
A 2 LP165-3 starters new top 2.0 g
A 3 XB-349 Thread Long 1.6 m
A 1 1213B76-6 Leather part 1.0 pcs
AB Designer B293
A 2 SLK90-9 New wave Bottom 48.5 g
A 2 LDFK-23-1 Feather Accent 0.36 g
A 2 78-83-123L Glitter thread Liner 0.12 g
A 2 LK-PO-143 starters new top 2.0 g
A 3 7893-JK-9 package Outer 1.3 g
A 1 1213C35-1 Covers
AB Designer L276
A 2 AITJ-837 Plastic
A 3 BM-223 Laso Bottom 3 m
A 1 1244B16-6 Leather3 part 4.0 pcs
AB Designer B291
A 2 SL256-3 New wave BottomCover 48.5 g
A 2 LDHT-22-1 Feather Blower 0.36 g
A 2 78-83-123L Glitter thread Liner 0.12 g
A 2 LK-PO-143 starters new top 2.0 g
A 3 7893-JK-9 package Inner 1.3 g

In this case, i will search for 1213C35-1 & 1213A45-1, this will then be the extract pasted in a new text file then saved in excel as tab delimited:

A 1 1213C35-1 Covers
AB Designer L276
A 2 AITJ-837 Plastic
A 3 BM-223 Laso Bottom 3 m
A 1 1213A45-1 Button part 3 pcs
AB Designer A348
A 2 GH23L-5 Illinois middle 0.5 g
A 2 LP165-3 starters new top 2.0 g
A 3 XB-349 Thread Long 1.6 m

Details that must contain each item is from A 1 to A 3.
Is this possible to code in VB excel?
This task is really tedious not to mention that there are lots of data to extract from a single file

 

[undercrisis01]

The interface would somehow look like this

(In VB form)
Locate File: C:\MyDocuments..\..txt

Enter Part numbers
1213C35-1
1213A45-1

ClickButton: Extract File


Any suggestions??
Thanks

 

[jim may]

Paste this into a Standard Module (You will need to CHANGE my RED references to your references, before running)..

Option Explicit
Sub ImportTextFile()
Dim Flg As Boolean
Dim lr As Long, Brow As Long, DNr As Long
Dim res As String, more As String
Dim C As Range, rng1 As Range
Dim wbDest As Workbook
    Flg = False
    Range("A:A").ClearContents
    Workbooks.OpenText Filename:="C:\Users\James\Documents\Temp000.txt", Origin _
        :=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
        , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _
        False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    ActiveSheet.Columns("A:A").EntireColumn.ColumnWidth = 39.71
    lr = Range("A" & Rows.Count).End(xlUp).Row
    Range("A1:A" & lr).Copy Destination:=ThisWorkbook.Sheets("Sheet1").Range("A1")
    ActiveWorkbook.Close False
    ActiveSheet.Columns("A:A").EntireColumn.ColumnWidth = 39.71
    Range("A" & lr + 1).Value = "A 1"
    Do
    res = InputBox("What Part Num Do you want?")  'example:  1213B76
    With Range("A1:A" & lr)
        Set C = .Find(What:=res, LookIn:=xlValues)
            If Not C Is Nothing Then
                .Range(C.Address).Select
                Brow = C.Row
                Do
                ActiveCell.Offset(1).Select
                Set rng1 = Range(Cells(Brow, 1), Cells(ActiveCell.Row, 1))
                Loop Until Left(ActiveCell.Offset(1), 3) = "A 1"
            End If
    End With
    If Flg = False Then
    Set wbDest = Workbooks.Add
    Flg = True
    rng1.Copy Destination:=wbDest.Sheets(1).Range("A1")
    more = MsgBox("Do you want additional Part Nums?", vbYesNo)
    If more = vbYes Then ThisWorkbook.Activate
    If more = vbNo Then GoTo errhandler
    Else
    DNr = wbDest.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1
    rng1.Copy Destination:=wbDest.Sheets(1).Range("A" & DNr)
    more = MsgBox("Do you want additional Part Nums?", vbYesNo)
    If more = vbYes Then ThisWorkbook.Activate
    End If
    Loop Until more = vbNo
errhandler:
    wbDest.SaveAs Filename:="C:\Users\James\Documents\MyNewTextFile.txt"
End Sub

 

[undercrisis01]

Hi Jim

This is awesome! i never thought this would be possible. Kudos to you

I tried your code and replaced the destination folder, however it returns me to this error

Run-time error '91'
Object Variable or with block variable not set

not sure what this means tho

Oh by the way, the lookup value to be matched is located in the 3rd column(bold)

P 2 KA78-88-109 BRKT COVER RH Component 1 EACH Released 00000
P 2 TA01-88-072A 0 CLIP A Component 1 EACH Released 72705
P 1 GB7F-57-100D90 FRONT SEAT, RH Assembly 0 EACH Released
PC MARCOBASB J56Y GB7F-57-100D90
P 2 GA2A-88-052 RETURN SPRING Component 1 EACH Released 17259
P 2 GA2A-88-063 BOLT-HINGE Component 1 EACH Released 00000
P 2 827934FAH AH GUIDE H/R (MASTER) - MDP Component 2 EACH Released 00577
P 2 827936FAG AG GUIDE H/R (SLAVE) - MDP Component 2 EACH Released 00577
P 1 118842FAJ AJ 60% MNTR CTH - BJC 04 Assembly 0 EACH 65.000 Released
PC MARCOBASB OBS4 118842FAJ
P 2 L0017622AB01 A01 2004-10-05 CVR ASSY- SIR RETRACTOR Component 1 EACH Released 77811
P 2 L0017650AA01BJ4 AB 2004-08-12 BEZEL - SIR MDK PARCH Component 1 EACH Released 77811
P 2 L0017959AA01BJ4 AB 2005-01-23 60% LATCH CVR-OB UPPER MDP Component 1 EACH Released 77811


if i input GB7F-57-100D90 to the search field, this is my expected result

P 1 GB7F-57-100D90 FRONT SEAT, RH Assembly 0 EACH Released
PC MARCOBASB J56Y GB7F-57-100D90
P 2 GA2A-88-052 RETURN SPRING Component 1 EACH Released 17259
P 2 GA2A-88-063 BOLT-HINGE Component 1 EACH Released 00000
P 2 827934FAH AH GUIDE H/R (MASTER) - MDP Component 2 EACH Released 00577
P 2 827936FAG AG GUIDE H/R (SLAVE) - MDP Component 2 EACH Released 00577

It stops right before the next P 1

Thanks for the response

 

[jim may]

My initial Import populates the text totally into Column A (I am not using text-to-columns so that the data is in the appropriate columns...)

Excel Workbook
	A
1	A 1 1213A45-1 Button part 3 pcs
2	AB Designer A348
3	A 2 GH23L-5 Illinois middle 0.5 g
4	A 2 LP165-3 starters new top 2.0 g
5	A 3 XB-349 Thread Long 1.6 m
6	A 1 1213B76-6 Leather part 1.0 pcs
7	AB Designer B293
8	A 2 SLK90-9 New wave Bottom 48.5 g
9	A 2 LDFK-23-1 Feather Accent 0.36 g
10	A 2 78-83-123L Glitter thread Liner 0.12 g
11	A 2 LK-PO-143 starters new top 2.0 g
12	A 3 7893-JK-9 package Outer 1.3 g
13	A 1 1213C35-1 Covers
14	AB Designer L276
15	A 2 AITJ-837 Plastic
16	A 3 BM-223 Laso Bottom 3 m
17	A 1 1244B16-6 Leather3 part 4.0 pcs
18	AB Designer B291
19	A 2 SL256-3 New wave BottomCover 48.5 g
20	A 2 LDHT-22-1 Feather Blower 0.36 g
21	A 2 78-83-123L Glitter thread Liner 0.12 g
22	A 2 LK-PO-143 starters new top 2.0 g
23	A 3 7893-JK-9 package Inner 1.3 g
24	A 1
Sheet1

Excel 2007

 

[undercrisis01]

So this code actually opens everything up in excel?

because the actual text file that i'm working on is so huge that an excel worksheet is not enough to accommodate all the contents, thats why i need to copy-paste only the details of the part numbers i need to another text pad , and from there i could finally transfer to excel.

 

[jim may]

What version of Excel are you using?

 

[undercrisis01]

Im currently using excel 2007

 

[Weaver]

Are you using compatibility mode?

Or is it a really big txt file

it would have to be > 1,048,576 (I think) rows to defeat xl2007, unless you're using compatibility mode, in which case the limit is 65,536

 

[undercrisis01]

Each text file would take from 65MB up to 100MB in size so its really huge that when i tried opening it in excel, my system would certainly hang up.

Oh by the way thanks for the links you have provided weaver. Not sure if i could grab something but its worth a try.


Its really late here in my timezone, I appreciate all the help you guys provided. ill go check this in the morning.