VBA Code to Extract Specific Data from .txt File into Excel

R John · Aug 7, 2017

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 #1

  Do Until EOF(1)
  Line Input #1, textline
  text = text & textline
  Loop

  Close #1

  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.

POST MOVED BY MODERATOR

Hui · Aug 7, 2017

try this version:

Code:

Sub Import_File()
'
' Import Files to worksheets as Text
'
' By: Hui
' Aug 2017
'

Dim strFilename As String
Dim strFileContent As String
Dim iFile As Integer
Dim MyTxtFile() As String

Dim MyFolder As String
Dim myFile As String
Dim cline As Integer
Dim arr() As String

MyFolder = "C:\" 'Change as appropriate

myFile = "dump2.txt" 'Select Txt file

ChDir MyFolder

Do While myFile <> ""
  'Add new worksheet
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = myFile
  Worksheets(myFile).Select

  Range("A1").Value = "Description"
  Range("B1").Value = "Speed"
  Range("c1").Value = "Service Num"
 
  iFile = FreeFile
 
  'Open TXT File and load it to an array
  Open myFile For Input As #iFile
  strFileContent = Input(LOF(iFile), iFile)

  Close #iFile
 
  'Split array to another array
  MyTxtFile = Split(strFileContent, vbLf)
  cline = 2
  'Loop through each line of the TXT File
  For i = 1 To UBound(MyTxtFile, 1)
   
  If InStr(1, MyTxtFile(i), "description") Then
  ActiveSheet.Cells(cline, 1) = Right(MyTxtFile(i), Len(MyTxtFile(i)) - 12)

  arr = Split(MyTxtFile(i), "_")
  ActiveSheet.Cells(cline, 2) = arr(UBound(arr, 1) - 2)
  ActiveSheet.Cells(cline, 3) = arr(UBound(arr, 1) - 1)

  cline = cline + 1
  End If
   
  Next i
   
Loop

Columns("A:C").EntireColumn.AutoFit
End Sub

Rick Rothstein · Aug 8, 2017

See if this macro does what you want (it writes to the active sheet which is assumed to be empty)...

Code:

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

By the way, this is the same solution I posted in the MrExcel forum where you cross-posted this same question. Here is the link for those who might care about this...

https://www.mrexcel.com/forum/excel...-excel-using-vba-post4885067.html#post4885067

dabblerc · May 5, 2018

Hi Hui
i had almost the same problem and tried testing the code you provided. However, i get the error Compile Error: Sub or Function not defined. Would you be able to help with that?

Rgds
WillC

Hui said:

try this version:

Code:

Sub Import_File()
'
' Import Files to worksheets as Text
'
' By: Hui
' Aug 2017
'

Dim strFilename As String
Dim strFileContent As String
Dim iFile As Integer
Dim MyTxtFile() As String

Dim MyFolder As String
Dim myFile As String
Dim cline As Integer
Dim arr() As String

MyFolder = "C:\" 'Change as appropriate

myFile = "dump2.txt" 'Select Txt file

ChDir MyFolder

Do While myFile <> ""
  'Add new worksheet
  Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = myFile
  Worksheets(myFile).Select

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

  iFile = FreeFile

  'Open TXT File and load it to an array
  Open myFile For Input As #iFile
  strFileContent = Input(LOF(iFile), iFile)

  Close #iFile

  'Split array to another array
  MyTxtFile = Split(strFileContent, vbLf)
  cline = 2
  'Loop through each line of the TXT File
  For i = 1 To UBound(MyTxtFile, 1)
  
  If InStr(1, MyTxtFile(i), "description") Then
  ActiveSheet.Cells(cline, 1) = Right(MyTxtFile(i), Len(MyTxtFile(i)) - 12)

  arr = Split(MyTxtFile(i), "_")
  ActiveSheet.Cells(cline, 2) = arr(UBound(arr, 1) - 2)
  ActiveSheet.Cells(cline, 3) = arr(UBound(arr, 1) - 1)

  cline = cline + 1
  End If
  
  Next i
  
Loop

Columns("A:C").EntireColumn.AutoFit
End Sub

Hui · May 5, 2018

Can you post the source file

dabblerc · May 6, 2018

Hi Hui

can i refer you to this link https://www.dropbox.com/sh/lxuw1c8xaiha9xx/AABXsc0BVbqzKaLhjJ3orGaDa?dl=0

my apologies, have to use this work around as company notebook doesn't allow uploading of info

dabblerc · May 14, 2018

Hi Hui, sorry, but were you able to see the file?

Hui · May 14, 2018

This code works fine:

Code:

Sub Import_File()
Dim strFilename As String
Dim strFileContent As String
Dim iFile As Integer
Dim MyTxtFile() As String

Dim MyFolder As String
Dim myFile As String
Dim cline As Integer
Dim arr() As String

MyFolder = "C:\Users\pc_1\Desktop" 'Change as appropriate

myFile = "dump2.txt" 'Select Txt file

ChDir MyFolder

Do While myFile <> ""
  'Add new worksheet
  Sheets.Add(After:=Sheets(Sheets.Count)).Name = myFile
 
  Worksheets(myFile).Select
 
  Range("A1").Value = "Description"
  Range("B1").Value = "Speed"
  Range("c1").Value = "Service Num"
 
  iFile = FreeFile
 
    'Open TXT File and load it to an array
  Open myFile For Input As #iFile
      strFileContent = Input(LOF(iFile), iFile)
  Close #iFile
 
    'Split array to another array
  MyTxtFile = Split(strFileContent, vbLf)
    cline = 2
    'Loop through each line of the TXT File
  For i = 1 To UBound(MyTxtFile, 1)
  Debug.Print i, MyTxtFile(i)
 
      If InStr(1, MyTxtFile(i), "description") Then
        ActiveSheet.Cells(cline, 1) = Right(MyTxtFile(i), Len(MyTxtFile(i)) - 12)
        arr = Split(MyTxtFile(i), "_")
        ActiveSheet.Cells(cline, 2) = arr(UBound(arr, 1) - 2)
        ActiveSheet.Cells(cline, 3) = arr(UBound(arr, 1) - 1)
        cline = cline + 1
      End If
  Next i
Loop

Columns("A:C").EntireColumn.AutoFit

End Sub

Results in:

try the attached file:

dabblerc · May 14, 2018

Hi Hui

yes, am able to get it to work so that i can adapt it for another scenario

. Am trying to understand how it works though.
would you be patient enough to help me out here
1) why do we need to input the text file to an array, and then split the array to another array?
2) what is cline? i tried google "excel vba cline" but am not getting any results useful there
3) ActiveSheet.Cells(cline, 1) = Right(MyTxtFile(i), Len(MyTxtFile(i)) - 12) why minus 12?
4) arr = Split(MyTxtFile(i), "_") Can i substitute "_" underscore with a line break? Actually that is my problem here where to extract specific data line by line to those columns

Thank you very much Hui

Hui · May 14, 2018

1) That is the easiest and quickest way to handle the data
Alternative way is to read it in line by line

2) cline is just a variable, It is a counter which increments by 1 every time a description is found

3) You aren't interested in the first 12 characters from the left

4) If you want each line you want to use MyTxtFile(i)
The split breaks each line into an array arr
arr(1) is the left most part from the start of the line to the first _
arr(2) is the middle part from the first _ to the second _
arr(3) is the middle part from the Second _ to the Third _
etc

dabblerc · May 15, 2018

Hi @Hui
thank you very much for the clarification. If I have a different file permutation where it is separated by carriage returns, how can I change the code to get the same result? e.g. file with carriage return

#
interface GigabitEthernet5/
vlan-type aser 7878
description: ABC_COMPANY
speed: 1M
service num:1254589
ip binding vpn-instance internet_vpn
ip address 158.214.125.215
#
interface GigabitEthernet5/0
vlan-type frin 2255
description: XYZ_COMPANY
speed:6M
service num:1458963
ip binding vpn-instance internet_vpn
ip address 148.214.25.214
#

I tried my hand but am afraid I kinda messed it up

Sub Import_File()
Dim strFilename As String
Dim strFileContent As String
Dim iFile As Integer
Dim MyTxtFile() As String
Dim MyFolder As String
Dim myFile As String
Dim cline As Integer
Dim arr() As String
MyFolder = "C:\Desktop" 'Change as appropriate
myFile = "dump3.txt" 'Select Txt file
ChDir MyFolder
Do While myFile <> ""
'Add new worksheet
Sheets.Add(After:=Sheets(Sheets.Count)).Name = myFile

Worksheets(myFile).Select

Range("A1").Value = "Description"
Range("B1").Value = "Details"
Range("c1").Value = "Remarks"

iFile = FreeFile

'Open TXT File and load it to an array
Open myFile For Input As #iFile
strFileContent = Input(LOF(iFile), iFile)
Close #iFile

'Split array to another array
MyTxtFile = Split(strFileContent, vbLf)
cline = 2
'Loop through each line of the TXT File
For i = 1 To UBound(MyTxtFile, 1)
Debug.Print i, MyTxtFile(i)

If InStr(1, MyTxtFile(i), "description:") Then
ActiveSheet.Cells(cline, 1) = Right(MyTxtFile(i), Len(MyTxtFile(i)) - 12)
arr = Split(MyTxtFile(i))
cline = cline + 1
End If

If InStr(1, MyTxtFile(i), "service num:") Then
ActiveSheet.Cells(cline, 1) = Right(MyTxtFile(i), Len(MyTxtFile(i)) - 13)
arr = Split(MyTxtFile(i))
cline = cline + 1
End If
If InStr(1, MyTxtFile(i), "Remarks:") Then
ActiveSheet.Cells(cline, 1) = Right(MyTxtFile(i), Len(MyTxtFile(i)) - 13)
arr = Split(MyTxtFile(i))
cline = cline + 1
End If

Next i
Loop
Columns("A:C").EntireColumn.AutoFit
End Sub

My apologies if this should go to a separate thread. Am happy to post it to separate thread for clarity purposes for other forum users

Marc L · May 15, 2018

Better is to attach source text file sample for each type …
How many lines (max) in real text files ?

A demonstration how to directly write 3 cells from a string :

Code:

Sub Demo0()
    Dim D$, R&, S$()
        D = "description ABC_COMPANY_1M_1254589_4444243"
        R = 1
    
    If D Like "description *" Then
        R = R + 1
        D = Mid$(D, 13)
        S = Split(D, "_")
        Cells(R, 1).Resize(, 3).Value = Array(D, S(2), S(3))
    End If

        ActiveSheet.UsedRange.Columns(1).AutoFit
End Sub

dabblerc · May 16, 2018

Hi @Marc
thank you so much. But can i refer you to a dropbox link https://www.dropbox.com/sh/lxuw1c8xaiha9xx/AABXsc0BVbqzKaLhjJ3orGaDa?dl=0

my apologies, as this is slightly different from the earlier example. instead of extracting the string from a line, but goes line by line reading and extract the string to the column. the worksheet readme explains it with the Sheet1 with the example. my apologies for not sharing that earlier

rgds

Marc L · May 16, 2018

So without any answer to my question,
according to your attachment
a classic beginner way demonstration as a starter :

Code:

Sub Demo1()
     Dim S, C%, R&, H, W, V(1 To 7)
         S = ThisWorkbook.Path & "\input1.txt"
         If Dir(S) = "" Then Beep: Exit Sub
         C = 1
         R = 1
         Open S For Input As #9
    With Sheet12
             H = .UsedRange.Rows(1).Value
            .UsedRange.Offset(1).Clear
             Application.ScreenUpdating = False
        While Not EOF(9)
                Line Input #9, S
                S = Split(S, " : ")
                W = Application.Match(S(0), H, 0)
            If IsNumeric(W) Then
                Select Case W
                    Case 1, 6
                        V(W) = S(1)
                    Case 2
                        C = C + 1
                        V(C) = S(1)
                    Case 7
                        V(7) = S(1)
                        C = 1
                        R = R + 1
                       .Cells(R, 1).Resize(, 7).Value = V
                        Erase V
                End Select
            End If
        Wend
    End With
        Close #9
        Application.ScreenUpdating = True
End Sub

Do you like it ? So thanks to click on bottom right Like !

dabblerc · May 17, 2018

Hi @Marc, very sorry overlooked that question.
Assume that it will in tens of thousands in the text file.

I tried running the code but didn't work, without even an error msg. I placed the file in the same folder as the Excel file. Anything i missed out?

rgds

Marc L · May 17, 2018

Works on my side like a charm with your attachment
so I hope you try with the same files :
open the sample workbook, Sheet1 must have columns headers
without any typo according to the sample text file …

dabblerc · May 18, 2018

Hi @Marc
my apologies. i tried again and nothing happened. can i refer you to the https://www.dropbox.com/sh/lxuw1c8xaiha9xx/AABXsc0BVbqzKaLhjJ3orGaDa?dl=0 to see what i did wrong there. There is a another zip file where i tried with your code.

- i created the Sheet 2, inserted the headers, and run the module from the VBA but nothing happened.
- i placed the input.txt as the same path as the excel file.
i didn't change this line of code. Am i supposed to?

S = ThisWorkbook.Path & "\input1.txt"

hmm.... where did i miss out?

Marc L · May 18, 2018

No need to create a new sheet as the import is directly loaded to Sheet1
- sorry typo in post #16 as I was thinking the second sheet by order -
as you can see on VBE side with its CodeName Sheet12 …

If you want to import in another worksheet, change the CodeName in code
with the worksheet CodeName or use a classic Worksheets reference …

In next picture, Sheet1 is the CodeName of the worksheet named abc :

dabblerc · May 20, 2018

Hi @Marc

okay, i tried
1) at Sheet 1 - inserted the headers, and run the module from the VBA but nothing happened.
2) at sheet 1, without anything run the module but again nothing happened

is it my vba version? can i refer you again to my dropbox path to show u the powerpoint screen capture of what i am talking about

https://www.dropbox.com/sh/lxuw1c8xaiha9xx/AABXsc0BVbqzKaLhjJ3orGaD

rgds

Marc L · May 20, 2018

All I can say is it works on my side on different Excel versions …

Try to see what happens by progressing the code on VBE side
in step by step mode via hitting F8 key with your initial attachment only.

Your second screenshot seems weird 'cause procedure name
is displayed like it is not located in the current workbook
where import worksheet stands …

dabblerc · Jun 5, 2018

Hi @Marc
thank you so much. I know it is a bit late, but finally gotten it to work.
instead of putting it in desktop, I put it both file and excel in a separate folder.
Then it took me quite a while to understand how the code works - yeah it took me that long

included in the comments below as per my understanding. Thanks again

HTML:

Sub Demo1()
    Dim S, C%, R&, H, W, V(1 To 7)
    'V (Vertical) is for Vertical the Columns
    'S (Source) is to get path of the input file
    'H (Horizontal) is for Row
        S = ThisWorkbook.Path & "\input1.txt"
        If Dir(S) = "" Then Beep: Exit Sub
        C = 1
        R = 1
        Open S For Input As #9
        '#9 is just for reference. All S will be referred to as 9 forthwith
    With Sheet1
            H = .UsedRange.Rows(1).Value
            'to loop through the Header of the first row
            .UsedRange.Offset(1).Clear
            Application.ScreenUpdating = False
            'read only the respective columns and to speed up the code
        While Not EOF(9)
                Line Input #9, S
                S = Split(S, " : ")
                'Split by colon
                W = Application.Match(S(0), H, 0)
                'W (Word) matches the word from the file with the Header
            If IsNumeric(W) Then
                Select Case W
                    Case 1, 6
                    'for name and postal
                        V(W) = S(1)
                    Case 2
                    'for address
                        C = C + 1
                        V(C) = S(1)
                    Case 7
                    'for email
                        V(7) = S(1)
                        C = 1
                        R = R + 1
                        'to move down 1 row
                      .Cells(R, 1).Resize(, 7).Value = V
                        Erase V
                End Select
            End If
        Wend
    End With
        Close #9
        Application.ScreenUpdating = True
End Sub

vletm · Feb 3, 2021

Rahul1089
This thread belongs to other member than You
and
You've opened already Your own thread.
This thread is closed now.
and
Your reply has deleted as duplicate.

VBA Code to Extract Specific Data from .txt File into Excel

New Member

Excel Ninja

New Member

New Member

Excel Ninja

New Member

New Member

Excel Ninja

Attachments

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja

New Member

Excel Ninja