• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 488
  • Last Modified:

VB script/macro for excel to extract numbers from txt file

We are trying to find/create coding/macro that will take certain sections of a .txt file and put them into rows 1, 2, 3, ect in cells, A, B, C and D in Excel. So the coding will skip the Stake-Out areas in the sample coding and extract the requested data right from where the areas start with an integer after a blank line and the output will look like below:
untitled.JPG
The sample file has been included and we want to extract the values for example of the screenshot included but all the way down: Any assistance offered would be appreciated.
04-23-6RPT.txt
05-01-8.txt
0
regsamp
Asked:
regsamp
  • 9
  • 7
  • 4
1 Solution
 
Bill PrewCommented:
What is the difference between the two TXT files you attached?  One seems to have a header, the other doesn't, do both these differing formats need to be supported?

Rather than worry about a macro in Excel, I would suggest a small VBS script that reads the input file, and extracts the data you want, and writes it to a CSV file in a comma delimited format.  That CSV can then be opened directly into Excel for processing, saving, etc.  Would that work?

~bp
0
 
Martin LissOlder than dirtCommented:
Will the data for Column A always be 5 characters long? It used to be 4.
0
 
regsampAuthor Commented:
I believe the characters should still be 4 in Column A. "One seems to have a header, the other doesn't, do both these differing formats need to be supported?"  Exactly, both need to be supported. The Manager seems to be wanting a macro so we can just make a button in Excel and run it.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Bill PrewCommented:
It also appears you want the "E1" values, but in one file I see things like this.  How are these to be handled?

El:D:TRAV N&DLB68


~bp
0
 
Bill PrewCommented:
So, in Excel, how will it know what file (or files?) to read?

And where will it store the imported values, to a new sheet that is created, or in an existing one?

If a new sheet, what should it be named, and where should it be placed relative to other sheets that exist?

~bp
0
 
regsampAuthor Commented:
I am sorry, it has to be the 5 characters. The manager told me the wrong value.
0
 
Martin LissOlder than dirtCommented:
In the data these are the last two lines. They don't follow the pattern of the previous data. Are they a mistake or are they always going to be there?

Pt.No.  Code    Northing        Easting   Elevation  Desc.
21680       1493364.117    603740.007     78.142  1\2" IRC TRAV1373/17(1384-56v)
0
 
Martin LissOlder than dirtCommented:
Try this code. It ignores the "Pt.No." line and the line following it.

Sub GetData()

Dim FF As Integer
Dim strLine As String
Dim intPos As Integer
Dim lngRow As Long
Dim dlgFile As FileDialog
Dim FileChosen As Integer

FF = FreeFile

' Choose the file to open
Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)
'the number of the button chosen
FileChosen = dlgFile.Show
dlgFile.Title = "Please choose file to import"
' Set the initial folder selection
dlgFile.InitialFileName = ThisWorkbook.Path
dlgFile.InitialView = msoFileDialogViewList
dlgFile.Filters.Clear
dlgFile.Filters.Add "Text Files", "*.txt"
dlgFile.Filters.Add "All files", "*.*"
dlgFile.FilterIndex = 1
' Set the ButtonName property to control the text on
' the OK button (the ampersand means the following
' letter is underlined and choosable with the ALT key)
dlgFile.ButtonName = "&Select file"
If FileChosen <> -1 Then
    MsgBox "You chose cancel"
    Exit Sub
End If

Open dlgFile.SelectedItems(1) For Input As #FF
 
'new
' Skip the three header lines
Line Input #FF, strLine
Line Input #FF, strLine
Line Input #FF, strLine

Do While Not EOF(FF)
    Line Input #FF, strLine
    If Left$(strLine, 6) = "Pt.No." Then
        Close
        Exit Sub
    End If
    
     ' The first line in a set is blank so get the next line
    Line Input #FF, strLine
     
    ' Find the first dash
    intPos = InStr(1, strLine, "-")
    lngRow = lngRow + 1
    Sheets("Sheet1").Cells(lngRow, 1) = Mid$(strLine, intPos + 10, 5)
    
    ' Get to the last line in the set
    Line Input #FF, strLine
    Line Input #FF, strLine
    ' Find "N:"
    intPos = InStr(1, strLine, "N:")
    Sheets("Sheet1").Cells(lngRow, 2) = Mid$(strLine, intPos + 2, 10)
    ' Find "E:"
    intPos = InStr(intPos, strLine, "E:")
    Sheets("Sheet1").Cells(lngRow, 3) = Mid$(strLine, intPos + 2, 10)
    ' Find "El:"
    intPos = InStr(intPos, strLine, "El:")
    Sheets("Sheet1").Cells(lngRow, 4) = Mid$(strLine, intPos + 3, 6)
Loop
Close
End Sub

Open in new window

0
 
regsampAuthor Commented:
Bill, this might help on the ideas of what we originally did and are looking for. Sorry for the confusion:
http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28663522.html

0
 
regsampAuthor Commented:
Okay, let me try that and post back.
0
 
Bill PrewCommented:
Ahhhh, had not seen that one (always a good idea to reference an earlier question in follow on posts).

Clearly Martin is on his way so I'll step aside and let him work his magic, thanks for clarifying.

~bp
0
 
Martin LissOlder than dirtCommented:
Thanks Bill.
0
 
regsampAuthor Commented:
I am sorry about that Bill. Thank you.
0
 
regsampAuthor Commented:
That will work perfectly. Thank you again. I really appreciate it and your help. Sorry again for the confusion Bill.
0
 
regsampAuthor Commented:
Excellent help.
0
 
Martin LissOlder than dirtCommented:
You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2015
0
 
Martin LissOlder than dirtCommented:
To be able to process  both types of files use this version.

Sub GetData()

Dim FF As Integer
Dim strLine As String
Dim intPos As Integer
Dim lngRow As Long
Dim dlgFile As FileDialog
Dim FileChosen As Integer
Dim bType2 As Boolean

FF = FreeFile

' Choose the file to open
Set dlgFile = Application.FileDialog(msoFileDialogFilePicker)
'the number of the button chosen
FileChosen = dlgFile.Show
dlgFile.Title = "Please choose file to import"
' Set the initial folder selection
dlgFile.InitialFileName = ThisWorkbook.Path
dlgFile.InitialView = msoFileDialogViewList
dlgFile.Filters.Clear
dlgFile.Filters.Add "Text Files", "*.txt"
dlgFile.Filters.Add "All files", "*.*"
dlgFile.FilterIndex = 1
' Set the ButtonName property to control the text on
' the OK button (the ampersand means the following
' letter is underlined and choosable with the ALT key)
dlgFile.ButtonName = "&Select file"
If FileChosen <> -1 Then
    MsgBox "You chose cancel"
    Exit Sub
End If

Open dlgFile.SelectedItems(1) For Input As #FF
 
' There are two types of files. One which I'll call Type 1 has no header lines and
' 4 data lines in each set of data, while the other which I'll call type 2 has 3
' header lines and 3 data lines in each set of data.

' Type 1 layout
' repeating set consiting of
'   blank line
'   4 lines of data

' Type 2 layout
' blank line
' "Steak-Out"
' header data
' repeating set consiting of
'   blank line
'   3 lines of data


' By pass the first line which is always blank.
Line Input #FF, strLine

' Determine if we have a Type1 file
Line Input #FF, strLine
' I could look for "Stake-out" which is what is in the one
' sample file that I have, but I'm assuming that that could change
' so instead since all data lines are longer than 20, I'm using
' that fact
If Len(strLine) < 20 Then
    bType2 = True
    ' Bypass the next header lines
    Line Input #FF, strLine
    Line Input #FF, strLine
Else
    bType2 = False
End If

Do While Not EOF(FF)
    If strLine = "" Then
        Line Input #FF, strLine
    ElseIf Left$(strLine, 3) = "Pt:" Then
        Line Input #FF, strLine
        ' Ignore the two footer lines at the end of type 2 files
        If Left$(strLine, 6) = "Pt.No." Then
            Close
            Exit Sub
        End If
        Line Input #FF, strLine
    End If
    
    
    ' Find the first dash
    intPos = InStr(1, strLine, "-")
    lngRow = lngRow + 1
    Sheets("Sheet1").Cells(lngRow, 1) = Mid$(strLine, intPos + 10, 5)
    
    ' Get to the last line in the set
   
    Line Input #FF, strLine
    Line Input #FF, strLine
    ' Type 1 files have 3 data lines while other have 4
    If Not bType2 Then
        Line Input #FF, strLine
    End If
        
    ' Find "N:"
    intPos = InStr(1, strLine, "N:")
    Sheets("Sheet1").Cells(lngRow, 2) = Mid$(strLine, intPos + 2, 10)
    ' Find "E:"
    intPos = InStr(intPos, strLine, "E:")
    Sheets("Sheet1").Cells(lngRow, 3) = Mid$(strLine, intPos + 2, 10)
    ' Find "El:"
    intPos = InStr(intPos, strLine, "El:")
    Sheets("Sheet1").Cells(lngRow, 4) = Mid$(strLine, intPos + 3, 6)
Loop

Close
End Sub

Open in new window

0
 
regsampAuthor Commented:
Thank you. I will try it first thing when I can try both files. TY again.
0
 
regsampAuthor Commented:
Pefect. Thank you again.
0
 
Martin LissOlder than dirtCommented:
You're welcome.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

  • 9
  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now