Extract specific data from .txt file into Excel using VBA

r_john

New Member
Joined
Aug 7, 2017
Messages
4
Have a .txt file that contains specific data that needs to be extracted and placed into corresponding columns in Excel. New to VBA coding so having difficulty in making this work... below shows the code I have thus far but when run, it only extracts the first set of data but does not move onto the next block of text. In the Excel file I need: Description (company Name) | Speed (eg 1M) | Service Num. (7-digit number after the speed). The following is sample data present in the .txt file:

#
interface GigabitEthernet5/
vlan-type aser 7878
description ABC_COMPANY_1M_1254589_4444243
ip binding vpn-instance internet_vpn
ip address 158.214.125.215
#
interface GigabitEthernet5/0
vlan-type frin 2255
description XYZ_COMPANY_6M_1458963_444
ip binding vpn-instance internet_vpn
ip address 148.214.25.214
#

All data required comes after the "interface GigabitEthernet" line (eg. Description: ABC_COMPANY | Speed: 1M | Service Num: 1254589)... there is also loads of data that comes before and after these blocks that does not need extracting.

The code below extracts correctly but does not move onto the next block of data required:

Code:
Private Sub CommandButton1_Click()
    Dim myFile As String, find1 As String, i As Integer, und As String, speed2 s Integer, text As String, Desc As String, r As Long, dashpos As Long, m As Long, textline As String, posLat As Integer, posLong As Integer, strLeft As String, strFind As String, strRight As String, strMid As String, speed As String

    myFile = "C:\dump2.txt"

    Open myFile For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 

    Do Until EOF(1)
    Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , textline
    text = text & textline
    Loop

    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 

    Desc = InStr(text, "interface GigabitEthernet")
    speed = InStr(text, "M_")

    Range("A1").Value = "Description"
    Range("B1").Value = "Speed"
    Range("c1").Value = "Service Num"

    Range("A2").Value = Mid(text, Desc + 68, 30)
    Range("b2").Value = Mid(text, speed + -3, 4)

    und = Mid(text, speed + -3, 4)

    speed2 = InStr(1, und, "_")

    Dim finalString As String
    finalString = Right(und, Len(und) - speed2 + 0)
    Range("b2").Value = finalString

    Desc = InStr(text, "interface GigabitEthernet")
    speed = InStr(text, "M_")
    Range("C2").Value = Mid(text, speed + 2, 6)
    End Sub

Appreciate any help with this... many thanks in advance.
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Have a .txt file that contains specific data that needs to be extracted and placed into corresponding columns in Excel.
See if this macro does what you want (it writes to the active sheet which is assumed to be empty)...
Code:
[table="width: 500"]
[tr]
	[td]Private Sub CommandButton1_Click()
  Dim X As Long, Rw As Long, FileNum As Long, TotalFile As String, Desc() As String, Txt() As String
  FileNum = FreeFile
  Open "C:\dump2.txt" For Binary As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] 
    TotalFile = Space(LOF(FileNum))
    Get [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] , , TotalFile
  Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=FileNum]#FileNum[/URL] 
  Desc = Split(TotalFile, "description", , vbTextCompare)
  Rw = 1
  Cells(Rw, "A").Resize(, 3) = Array("Description", "Speed", "Service Num")
  For X = 1 To UBound(Desc)
    Rw = Rw + 1
    Txt = Split(Trim(Left(Desc(X), InStr(Desc(X), vbNewLine) - 1)), "_")
    Cells(Rw, 3) = Txt(UBound(Txt) - 1)
    Cells(Rw, 2) = Txt(UBound(Txt) - 2)
    Cells(Rw, 1) = Trim(Replace(Left(Desc(X), InStr(Desc(X), Txt(UBound(Txt) - 2)) - 2), "_", " "))
  Next
End Sub[/td]
[/tr]
[/table]
 
Upvote 0
Hi,

I have a question I am a new in excel vba I want to extract specific information from text file to my worksheet but I don't know how can you help me?


BALAGTASBCISR2#
BALAGTASBCISR2#!
BALAGTASBCISR2#en
BALAGTASBCISR2#opnet2h12
Translating "opnet2h12"...domain server (255.255.255.255)

% Bad IP address or host name
Translating "opnet2h12"...domain server (255.255.255.255)
(255.255.255.255)
Translating "opnet2h12"...domain server (255.255.255.255)

% Unknown command or computer name, or unable to find computer address
BALAGTASBCISR2#!
BALAGTASBCISR2#show proc cpu sorted | e 0.0
CPU utilization for five seconds: 0%/0%; one minute: 1%; five minutes: 1%
PID Runtime(ms) Invoked uSecs 5Sec 1Min 5Min TTY Process
191 24 3792924 0 0.23% 0.23% 0.23% 0 HQF Output Shape
83 68 60852 1 0.15% 0.15% 0.15% 0 Netclock Backgro
99 4 1939702 0 0.15% 0.13% 0.13% 0 Ethernet Msec Ti
14 14692 15196 966 0.15% 0.21% 0.19% 0 Environmental mo

BALAGTASBCISR2#!
BALAGTASBCISR2#sh int gig0/1
GigabitEthernet0/1 is up, line protocol is up
Hardware is CN Gigabit Ethernet, address is a0ec.f9bf.ff71 (bia a0ec.f9bf.ff71)
Description: { Link to PDLASR01 G0/0/0/5 }
Internet address is 10.221.2.23/28
MTU 1500 bytes, BW 6000 Kbit/sec, DLY 100 usec,
reliability 255/255, txload 1/255, rxload 1/255
Encapsulation ARPA, loopback not set
Keepalive set (10 sec)
Full Duplex, 100Mbps, media type is RJ45
output flow-control is unsupported, input flow-control is unsupported
ARP type: ARPA, ARP Timeout 04:00:00
Last input 00:00:04, output 00:00:03, output hang never
Last clearing of "show interface" counters never
Input queue: 0/75/0/0 (size/max/drops/flushes); Total output drops: 0
Queueing strategy: Class-based queueing
Output queue: 0/1000/0 (size/max total/drops)
5 minute input rate 0 bits/sec, 0 packets/sec
5 minute output rate 0 bits/sec, 0 packets/sec
593 packets input, 59034 bytes, 0 no buffer
Received 25 broadcasts (0 IP multicasts)
0 runts, 0 giants, 0 throttles
0 input errors, 0 CRC, 0 frame, 0 overrun, 0 ignored
0 watchdog, 0 multicast, 0 pause input
2402 packets output, 253637 bytes, 0 underruns
0 output errors, 0 collisions, 0 interface resets
0 unknown protocol drops
0 babbles, 0 late collision, 0 deferred
0 lost carrier, 0 no carrier, 0 pause output
0 output buffer failures, 0 output buffers swapped out
BALAGTASBCISR2#!
BALAGTASBCISR2#sh int gig0/2
GigabitEthernet0/2 is up, line protocol is up
Hardware is CN Gigabit Ethernet, address is a0ec.f9bf.ff72 (bia a0ec.f9bf.ff72)
Description: { Link to BALAGTASBCISRG1 G0/2 }
MTU 1500 bytes, BW 39000 Kbit/sec, DLY 10 usec,
reliability 255/255, txload 1/255, rxload 1/255
Encapsulation 802.1Q Virtual LAN, Vlan ID 1., loopback not set
Keepalive set (10 sec)
Full Duplex, 1Gbps, media type is RJ45
output flow-control is XON, input flow-control is XON
ARP type: ARPA, ARP Timeout 04:00:00
Last input 00:00:21, output 00:00:00, output hang never
Last clearing of "show interface" counters never
Input queue: 0/75/0/0 (size/max/drops/flushes); Total output drops: 4
Queueing strategy: Class-based queueing
Output queue: 0/1000/4 (size/max total/drops)
5 minute input rate 0 bits/sec, 0 packets/sec
5 minute output rate 51000 bits/sec, 25 packets/sec
864 packets input, 158288 bytes, 0 no buffer
Received 285 broadcasts (0 IP multicasts)
0 runts, 0 giants, 0 throttles
0 input errors, 0 CRC, 0 frame, 0 overrun, 0 ignored
0 watchdog, 284 multicast, 0 pause input
304725 packets output, 62633453 bytes, 0 underruns
0 output errors, 0 collisions, 0 interface resets
1 unknown protocol drops
0 babbles, 0 late collision, 0 deferred
0 lost carrier, 0 no carrier, 0 pause output
0 output buffer failures, 0 output buffers swapped out
BALAGTASBCISR2#!
BALAGTASBCISR2#sh int gig1/1
GigabitEthernet1/1 is up, line protocol is up
Hardware is EE Internal Service Module, address is 0000.0000.0009 (bia 0000.0000.0009)
Description: {Internal switch interface connected to Service Module}
MTU 1500 bytes, BW 1000000 Kbit/sec, DLY 10 usec,
reliability 255/255, txload 1/255, rxload 1/255
Encapsulation ARPA, loopback not set
Keepalive set (10 sec)
Full-duplex, 1000Mb/s
ARP type: ARPA, ARP Timeout 04:00:00
Last input 00:00:00, output never, output hang never
Last clearing of "show interface" counters never
Input queue: 0/75/0/0 (size/max/drops/flushes); Total output drops: 0
Queueing strategy: fifo
Output queue: 0/40 (size/max)
5 minute input rate 54000 bits/sec, 32 packets/sec
5 minute output rate 2000 bits/sec, 3 packets/sec
392719 packets input, 70924975 bytes, 0 no buffer
Received 46917 broadcasts (37090 multicasts)
0 runts, 0 giants, 0 throttles
0 input errors, 0 CRC, 0 frame, 0 overrun, 0 ignored
0 watchdog, 0 multicast, 0 pause input
0 input packets with dribble condition detected
49717 packets output, 4015719 bytes, 0 underruns
0 output errors, 0 collisions, 2 interface resets
509 unknown protocol drops
0 babbles, 0 late collision, 0 deferred
0 lost carrier, 0 no carrier, 0 pause output
0 output buffer failures, 0 output buffers swapped out
BALAGTASBCISR2#!
BALAGTASBCISR2#sh interfaces counters errors

Port Align-Err FCS-Err Xmit-Err Rcv-Err UnderSize
Gi1/1 0 0 0 0 0

Port Single-Col Multi-Col Late-Col Excess-Col Carri-Sen Runts Giants
Gi1/1 0 0 0 0 0 0 0
BALAGTASBCISR2#

I want to get all inputs I already put red color on the information that I need to get and put it on my worksheet can you give me example?

Thanks a lot!
 
Upvote 0
It would have been a better idea for you to have started a new thread rather than to have asked your question in this one (your question would have been exposed to more volunteers who could possibly answered it). With that said, I think the following macro may do what you want. First, though, you have to change the made up path/filename I used (highlighted in red) to the actual path/filemame for your text file. Also note that output will go to Column A of the active worksheet so make sure you have a blank worksheet as your active sheet.
Code:
[table="width: 500"]
[tr]
	[td]Sub Holiday_Drew()
  Dim X As Long, B As Long, FileNum As Long, TotalFile As String
  Dim Bytes() As Long, Packets() As String, Txt() As String
  FileNum = FreeFile
  Open "[B][COLOR="#FF0000"]C:\temp\test.txt[/COLOR][/B]" For Binary As #FileNum 
    TotalFile = Space(LOF(FileNum))
    Get #FileNum , , TotalFile
  Close #FileNum
  Packets = Split(TotalFile, " packets ", , vbTextCompare)
  ReDim Bytes(1 To UBound(Packets) + 1, 1 To 1)
  For X = 1 To UBound(Packets)
    Txt = Split(Packets(X))
    If (Txt(0) = "input," Or Txt(0) = "output,") And Not Txt(1) Like "*[!0-9]*" Then
      B = B + 1
      Bytes(B, 1) = Txt(1)
    End If
  Next
  Range("A1").Resize(B) = Bytes
End Sub[/td]
[/tr]
[/table]

HOW TO INSTALL MACROs
------------------------------------
If you are new to macros, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. To use the macro, go back to the worksheet with your data on it and press ALT+F8, select the macro name (Holiday_Drew) from the list that appears and click the Run button. The macro will execute and perform the action(s) you asked for. If you will need to do this again in this same workbook, and if you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "Yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.
 
Last edited:
Upvote 0
Hi Sir MrExcel MVP,

This is working but I want to have a result like this position please see below screenshot


-- removed inline image ---


how can I set this using vba? thanks next time I will create another thread sir sorry thanks for the big help...also can I use a button for this?

Thanks for the big help sir!
 
Upvote 0
Hi Sir MrExcel MVP,

This is working but I want to have a result like this position please see below screenshot


-- removed inline image ---

how can I set this using vba? thanks next time I will create another thread sir sorry thanks for the big help...also can I use a button for this?

Thanks for the big help sir!
 
Upvote 0
This is working but I want to have a result like this position please see below screenshot
Your screenshot did not display. Can you describe what it should look like (which, by the way, you did not do in your original post, so I am not sure how you expected us to guess at whatever it is you really want)?
 
Upvote 0
I want to set like this position I can't attach the screenshot sir sorry thanks for the bighelp

59034 253637
158288 62633453
70924975 4015719

also can I use button for this?
 
Upvote 0
I want to set like this position I can't attach the screenshot sir sorry thanks for the bighelp

59034 253637
158288 62633453
70924975 4015719
I am assuming that is Input in one column and output in the next. Give this code a try (it assumes the "input", "output" packet byte numbers always alternate in the text file)...
Code:
Sub Holiday_Drew()
  Dim X As Long, B As Long, FileNum As Long, TotalFile As String
  Dim Bytes() As Long, Packets() As String, Txt() As String
  FileNum = FreeFile
  Open "C:\temp\test.txt" For Binary As #FileNum 
    TotalFile = Space(LOF(FileNum))
    Get #FileNum , , TotalFile
  Close #FileNum 
  Packets = Split(TotalFile, " packets ", , vbTextCompare)
  ReDim Bytes(1 To UBound(Packets) + 1, 1 To 2)
  For X = 1 To UBound(Packets)
    Txt = Split(Packets(X))
    If Txt(0) = "input," And Not Txt(1) Like "*[!0-9]*" Then
      B = B + 1
      Bytes(B, 1) = Txt(1)
    ElseIf Txt(0) = "output," And Not Txt(1) Like "*[!0-9]*" Then
      Bytes(B, 2) = Txt(1)
    End If
  Next
  Range("A1").Resize(B, 2) = Bytes
End Sub



also can I use button for this?
Yes. What kind of button is it... Forms or ActiveX ?
 
Last edited:
Upvote 0

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top