1. Welcome to Chandoo.org Forums. Short message for you

    Hi Guest,

    Thanks for joining Chandoo.org forums. We are here to make you awesome in Excel. Before you post your first question, please read this short introduction guide. When posting or responding to questions please remember our values at Chandoo.org are: Humility, Passion, Fun, Awesomeness, Simplicity, Sharing Remember that we have people here for whom English is not there first language and we need to allow for this in our dealings.

    Yours,
    Chandoo
  2. Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  3. When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

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

Discussion in 'VBA Macros' started by R John, Aug 7, 2017.

  1. R John

    R John New Member

    Messages:
    1
    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 (vb):
    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
    Last edited by a moderator: Aug 7, 2017
  2. Hui

    Hui Excel Ninja Staff Member

    Messages:
    11,354
    try this version:

    Code (vb):

    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
  3. Rick Rothstein

    Rick Rothstein New Member

    Messages:
    2
    See if this macro does what you want (it writes to the active sheet which is assumed to be empty)...
    Code (vb):
    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
  4. dabblerc

    dabblerc New Member

    Messages:
    10
    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

  5. Hui

    Hui Excel Ninja Staff Member

    Messages:
    11,354
    Can you post the source file
  6. dabblerc

    dabblerc New Member

    Messages:
    10
  7. dabblerc

    dabblerc New Member

    Messages:
    10
    Hi Hui, sorry, but were you able to see the file? :)
  8. Hui

    Hui Excel Ninja Staff Member

    Messages:
    11,354
    This code works fine:
    Code (vb):
    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:

    upload_2018-5-14_13-56-32.png

    try the attached file:

    Attached Files:

  9. dabblerc

    dabblerc New Member

    Messages:
    10
    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
  10. Hui

    Hui Excel Ninja Staff Member

    Messages:
    11,354
    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
  11. dabblerc

    dabblerc New Member

    Messages:
    10
    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

    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
  12. Marc L

    Marc L Excel Ninja

    Messages:
    3,814
    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 (vb):
    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
  13. dabblerc

    dabblerc New Member

    Messages:
    10
    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
  14. Marc L

    Marc L Excel Ninja

    Messages:
    3,814
    So without any answer to my question,
    according to your attachment
    a classic beginner way demonstration as a starter :​
    Code (vb):
    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 !
  15. dabblerc

    dabblerc New Member

    Messages:
    10
    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
  16. Marc L

    Marc L Excel Ninja

    Messages:
    3,814

    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 …
  17. dabblerc

    dabblerc New Member

    Messages:
    10
    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?
  18. Marc L

    Marc L Excel Ninja

    Messages:
    3,814
    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 :

    [​IMG]
  19. dabblerc

    dabblerc New Member

    Messages:
    10
    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
  20. Marc L

    Marc L Excel Ninja

    Messages:
    3,814
    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 …

Share This Page