Solved: Extracting based on key from text file.

[khalid79m]

I have a txt file which is pipe delimited and each line equals 1 record and contains a key for example

1056545MKZ|Apple|Size1|ClassB|0.50|0.90|0.90|
1054578MKZ|Apple|Size1|ClassC|0.50|0.20|0.90|
1056556MKZ|Apple|Size1|ClassZ|0.50|0.77|0.90|
1054578MKZ|Apple|Size1|ClassC|0.50|0.20|0.90|
1056545MKZ|Apple|Size1|ClassB|0.50|0.90|0.90|
1056545MKZ|Apple|Size1|ClassB|0.50|0.90|0.90|
1056545MKZ|Apple|Size1|ClassB|0.50|0.90|0.90|
1054578MKZ|Apple|Size1|ClassC|0.50|0.20|0.90|

I need an excel script to open and go thru this txt file an pull me back all records with 1054578MKZ (key) into sheet "Data" , range A1,

result :

1054578MKZ|Apple|Size1|ClassC|0.50|0.20|0.90|
1054578MKZ|Apple|Size1|ClassC|0.50|0.20|0.90|
1054578MKZ|Apple|Size1|ClassC|0.50|0.20|0.90|


I have no idea how to do this.. need help.. never used txt files

[Charlize]

Just to give you some idea.
[VBA]Sub Get_Keys()
Dim fs, a
Dim t As String, itemloop As Long
Dim MyFile As String, mydata, request
Dim answers, myrow As Long
'txt file is located in c:\data and name = thetextfile.txt
MyFile = "C:\data\thetextfile.txt"
Set fs = CreateObject("Scripting.FileSystemObject")
Set a = fs.openTextFile(MyFile)
On Error GoTo end_of_file
'give the keys to look for separated by the delimiter
'you can look for more keys or only one
'if only one, no delimiter needed, if two, no ending delimiter
'ex. 1054578MKZ or 1054578MKZ|1054566MKZ
request = InputBox("Give keys seperated by |", "Searching keys ...")
If request <> vbNullString Then
myrow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Do
t = a.readline
For answers = LBound(Split(request, "|")) To UBound(Split(request, "|"))
mydata = Split(t, "|")
If mydata(0) = Split(request, "|")(answers) Then
'a b c d e f g
For itemloop = LBound(mydata) To UBound(mydata)
ActiveWorkbook.ActiveSheet.Cells(myrow, itemloop + 1) = mydata(itemloop)
Next itemloop
myrow = myrow + 1
End If
Next answers
Loop
End If
end_of_file:
a.Close
MsgBox "Finished your request.", vbInformation
End Sub[/VBA]Charlize

[Tinbendr]

Another way.
[vba]Sub GetKeyLine()
Dim FN$
Dim SrchString As String
Dim DataLine$
Dim LCount As Long
Dim DataArray() As String
Dim FNum As Long
SrchString = InputBox("Enter Search String", "Search")
'SrchString = "1054578MKZ"
FN$ = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If FN$ <> "False" Then
FNum = FreeFile
Open FN$ For Input As #FNum
Do
Line Input #FNum, DataLine$
If Left(DataLine$, Len(SrchString)) = SrchString Then
LCount = LCount + 1
ReDim Preserve DataArray(1 To LCount)
DataArray(LCount) = DataLine$
End If
Loop Until EOF(FNum)
Close #FNum

With Sheets(1)
.Cells(1, "A").Resize(LCount) = DataArray()
With .Range("A1").CurrentRegion
.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
End With
End With

End If
End Sub[/vba]

[Tinbendr]

My code has a flaw in it, so be sure to use Charlize.

I'll repost if I get it sorted.

[Tinbendr]

ok, figured it out.

Change
[VBA].Cells(1, "A").Resize(LCount) = DataArray()[/VBA]to
[VBA]
.Range("A1:A" & LCount).Value = Application.WorksheetFunction.Transpose(DataArray)

[/VBA]

[khalid79m]

You guys are help pioneer amazing service, keep it up! I will check the code asap and come back to you.

[mdmackillop]

For many records, it may be quicker to avoid looping.
[VBA]Option Explicit

Sub Macro1()
Dim ws As Worksheet
Dim Rng As Range
Dim MyKey As String
Dim MyPath As String
Dim Tgt As Range

'Set parameters
MyKey = InputBox("Enter key", , "1054578MKZ")
MyPath = "C:\data\TheTextFile.txt"
Set Tgt = Sheets("Data").Cells(1, 1)

Set ws = Sheets.Add
With ws.QueryTables.Add(Connection:="TEXT;" & MyPath, _
Destination:=Range("$A$2"))
.TextFileOtherDelimiter = "|"
.Refresh BackgroundQuery:=False
End With

Set Rng = Range("$A$1")
Rng(1) = "Data"
Set Rng = Rng.CurrentRegion
Rng.AutoFilter Field:=1, Criteria1:=MyKey
Rng.Offset(1).SpecialCells(xlCellTypeVisible).Copy Tgt
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub[/VBA]

[khalid79m]

mdmackillop,

thanks it worked a treat, and thanks to all for help