Solved: extracr specific data from a file

[rafi_07max]

For this thread would like to know once I opened a txt file instead of opening the entire contents from the file, I would like my macro to Step 1
Look for the line that start with “device” and extract the word beside “device” and place it on column A, look at the image below:
http://www.iimmgg.com/image/ad23050f...db13613f46c077

Step 2:
Look for the line that start with either “test pins” or “test node”, and get the word beside the word “ test pins” or “test node”, and put them in column B. look at the image below:
http://www.iimmgg.com/image/61d6cc69...2d83c1724c497c
Step 3:
Do step 2 until the macro detect the line “end device”, look at the image below:
http://www.iimmgg.com/image/a2954f4d...b59b7f139bbc8e

Keep repeating the three steps until the end of the file. look at the image below:
http://www.iimmgg.com/image/132e2327...bd2df6977c8df5

The image below shows how the final outcome should look like,
http://www.iimmgg.com/image/1d51c1cc...a707888c6ad4de


I have attached a zip file,
Inside the zip file I have attached a sample workbook with sheet 1 contains a button where the codes should be inserted and sheet2 shows how the sample output looks like
I have also attached a sample .txt file that needs to be extracted
Attachment 5029

[p45cal]

Outputs to same sheet as button is on. Adjust file name and path. Paste this into the sheet's code module:
[vba]Private Sub CommandButton1_Click()
fileno = FreeFile
Open "C:\Documents and Settings\John Doe\My Documents\testJet\1%testjet.txt" For Input As fileno 'ADJUST the file name!!
Do While Not EOF(fileno)
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "device") = 1 Then
y = Split(x, " ")
destrow = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 2).End(xlUp).Row) + 1
Cells(destrow, 1) = y(1)
Do
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "test pins") = 1 Or InStr(1, x, "test node") = 1 Then
y = Split(x, " ")
mystr = y(2)
If Right(mystr, 1) = ";" Then mystr = Left(mystr, Len(mystr) - 1)
Cells(destrow, 2) = mystr
destrow = destrow + 1
End If
Loop Until InStr(1, x, "end device") = 1
End If
Loop
Close #fileno
End Sub
[/vba]No checks that device/end device strings appear in pairs. In fact, nothing much making it robust at all, but it should get you started.

[Sean.DiSanti]

another way to skin the cat
[VBA]Private Sub CommandButton1_Click()
x = 1
Open "c:\test.txt" For Input As #1
While Not EOF(1)
Line Input #1, tl
If Left(LCase(tl), 6) = "device" Then
tmp = Split(tl, Chr(34))
Worksheets(1).Range("a" & x).Formula = tmp(1)
End If
If Left(LTrim(tl), 9) = "test node" Then
tmp = Split(tl, Chr(34))
Worksheets(1).Range("b" & x).Formula = tmp(1)
x = x + 1
End If
If Left(LTrim(tl), 9) = "test pins" Then
tmp = Split(LTrim(tl), " ")
Worksheets(1).Range("b" & x).Formula = Left(tmp(2), Len(tmp(2)) - 1)
x = x + 1
End If
If Left(tl, 3) = "end" Then x = x + 1
Wend
Close #1
End Sub
[/VBA]

[p45cal]

another way to skin the cat

Careful.. not all test pins have a semicolon, so you're removing a digit from them. Some interesting things happenning with quote marks too.

[Sean.DiSanti]

[vba]Private Sub CommandButton1_Click()
x = 1
Open "c:\test.txt" For Input As #1
While Not EOF(1)
Line Input #1, tl
If Left(LCase(tl), 6) = "device" Then
tmp = Split(tl, Chr(34))
Worksheets(1).Range("a" & x).Formula = tmp(1)
End If
If Left(LTrim(tl), 9) = "test node" Then
tmp = Split(tl, Chr(34))
Worksheets(1).Range("b" & x).Formula = tmp(1)
x = x + 1
End If
If Left(LTrim(tl), 9) = "test pins" Then
tmp = Split(LTrim(tl), " ")
if NOT IsNumeric(tmp(2)) then
Worksheets(1).Range("b" & x).Formula = Left(tmp(2), Len(tmp(2)) - 1)
else
Worksheets(1).Range("b" & x).Formula = tmp(2)
end if

x = x + 1
End If
If Left(tl, 3) = "end" Then x = x + 1
Wend
Close #1
End Sub[/vba]
added in a check for the semi, it wouldn't let me edit my other posting

[rafi_07max]

Thanks a lot p45cal and Sean.DiSanti for your time and help.
The codes works

[Sean.DiSanti]

no problem, glad to help

[rafi_07max]

Hi p45cal,
I have used your codes
Is it possible for you to do a slight editing to the program.
I will explain what I need to do and let you see whether you could provide any help

I want to do some editing to step 2:
If you look at the step 2 in my thread above, it say look for the line that start with either “test pins” or “testnode”,……

But instead for this I want to look for lines that start with “!” and once detected look if the next word is “test pins” or “test node”, and get the word beside the word “test pins” or “test node” and put them in column C.
Take a look at the image below:
Attachment 5053

The rest of the steps remains unchaged.

[p45cal]

I've assumed that:
"But instead for this I want to look for lines that start with “!”"
was meant to read:
"But as well as this I want to look for lines that start with “!”"

To make the changes as simple as possible I've made a slight change to your logic. In your txt file ALL lines containing anywhere "test pins" or "test node" start with either "test" or "!". So instead of looking for the strings "test pins" or "test node" at the extreme left of the line, I looked for them anywhere in the line, then took the 4th word if the line started "!", otherwise took the 3rd word.
You need to check whether this is valid logic for other .txt files.
[vba]Private Sub CommandButton1_Click()
fileno = FreeFile
Open "C:\Documents and Settings\Fred Bloggs\My Documents\testJet\1%testjet.txt" For Input As fileno 'ADJUST!!
Do While Not EOF(fileno)
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "device") = 1 Then
y = Split(x, " ")
destrow = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 2).End(xlUp).Row) + 1
Cells(destrow, 1) = y(1)
Do
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "test pins") > 0 Or InStr(1, x, "test node") > 0 Then
y = Split(x, " ")
If Left(y(0), 1) = "!" Then mycol = 3 Else mycol = 2
mystr = y(mycol)
If Right(mystr, 1) = ";" Then mystr = Left(mystr, Len(mystr) - 1)
Cells(destrow, mycol) = mystr
destrow = destrow + 1
End If
Loop Until InStr(1, x, "end device") = 1
End If
Loop
Close #fileno
End Sub
[/vba] At the moment, the file name and path is hard coded, if you have many files to process it's not difficult to change this to allow you to select the file with a dialogue box.

[edit post posting:
I have found a line in the text file which may be handled wrongly:
!? !ADB test pins "A2"; threshold low 2 high 21 !ADB: 10,0.121,0.15,20.0,10000.0,-3.08
What should happen with this line?

and another:
!?Btest pins "C15"; threshold low 30 high 183 !ADB: 10,0.199,60.98,20.0,10000.0,12.91
with no space before "test"
how should this line be processed?]

[rafi_07max]

Thanks p45cal for your help. It works. About the two lines that you asked, they are not needed.

Is it possible for you to remove all the empty cells in column B and C.
Take a look at the image below:
Attachment 5058

[p45cal]

[vba]
Private Sub CommandButton1_Click()
fileno = FreeFile
Open "C:\Documents and Settings\JohnSmith\My Documents\testJet\1%testjet.txt" For Input As fileno 'ADJUST!!
Do While Not EOF(fileno)
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "device") = 1 Then
y = Split(x, " ")
destrow = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 2).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row) + 1
Cells(destrow, 1) = y(1)
Do
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "test pins") > 0 Or InStr(1, x, "test node") > 0 Then
y = Split(x, " ")
If Left(y(0), 1) = "!" Then mycol = 3 Else mycol = 2
mystr = y(mycol)
If InStr(";,", Right(mystr, 1)) > 0 Then mystr = Left(mystr, Len(mystr) - 1)
Cells(Application.Max(destrow, Cells(Rows.Count, mycol).End(xlUp).Offset(1).Row), mycol) = mystr
End If
Loop Until InStr(1, x, "end device") = 1
End If
Loop
Close #fileno
End Sub
[/vba]
re:"About the two lines that you asked, they are not needed."
Sadly, the code above (and the earlier code) include them in the results; the first appearing as 'pins' in the 3rd column and the 2nd appearing as 'threshold' in the 3rd column.
Does it matter?

[rafi_07max]

Hi p45cal, thanks for the codes. It works.
About the two lines, is it possible to exclude them, if it is tedious to do the adjustments, then its okay, I’ll will stick with the current codes.

[p45cal]

[vba]
Private Sub CommandButton1_Click()
fileno = FreeFile
Open "C:\Documents and Settings\FredBloggs\My Documents\testJet\1%testjet.txt" For Input As fileno 'ADJUST!!
Do While Not EOF(fileno)
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "device") = 1 Then
y = Split(x, " ")
destrow = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 2).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row) + 2
Cells(destrow, 1) = y(1)
Do
Line Input #fileno, x
x = Application.Trim(Replace(x, """", ""))
If InStr(1, x, "test pins") > 0 Or InStr(1, x, "test node") > 0 Then
y = Split(x, " ")
If y(0) = "test" Or y(1) = "test" Then
If Left(y(0), 1) = "!" Then mycol = 3 Else mycol = 2
mystr = y(mycol)
If InStr(";,", Right(mystr, 1)) > 0 Then mystr = Left(mystr, Len(mystr) - 1)
Debug.Assert mystr <> "pins"
Cells(Application.Max(destrow, Cells(Rows.Count, mycol).End(xlUp).Offset(1).Row), mycol) = mystr
End If
End If
Loop Until InStr(1, x, "end device") = 1
End If
Loop
Close #fileno
End Sub
[/vba]

[Sean.DiSanti]

wow you're way more helpful than me.

[rafi_07max]

Thanks p45cal for your time and help. It works