Extract Data From Text File into Excel using VBA or a Macro?

cyliyu · Jul 12, 2015

Demo 2a is good enough.
It only took me less than a min to import 600 data.

yes, I have re-start my computer, re-Open workbook and paste code to worksheet module. same results.

With Demo 2a code, I just need to import the data from 5 different testers (from different locations) and combine them into one spreadsheet to plot the CP/CPK, Distribution chart etc and more.

I can bare with it to manual insert a column after "A" if I need to add-in more info or remarks and manual replace the row 7 to date format. not a big concerns.

Thanks a million.

Marc L · Jul 12, 2015

Demo2b :

…

Test it with same sample log 23 files in another test directory …

Follow code progress in VBE via F8 key and watch C variable …

cyliyu · Jul 12, 2015

Weird !I tested with the 23 log files it works.
but the other set of data won't work.

Marc L · Jul 12, 2015

Now I get same issue (plus an error message) with this RESULT directory !

So I have to inspect what's going on … (need time)

cyliyu · Jul 12, 2015

The error message was due to the log file name started with P22.... and P26....
Just ignore those files.

Marc L · Jul 12, 2015

Solved ! Issue came from log files without data
like 91Q33216212321600220301.log for example …
So C variable stays to zero …

Code:

Sub Demo2c()
Const FC = 4, TEST1 = "Test completed", TEST2 = TEST1 & vbTab & vbTab
  Dim COL(), SP$()

With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Select"
    .InitialFileName = ThisWorkbook.Path & "\"
        .InitialView = msoFileDialogViewList
              .Title = Space$(27) & "Choose the log files directory :"
    If .Show Then D$ = .SelectedItems(1) & "\" Else Exit Sub
End With
                  N$ = Dir$(D & "*.log"):  If N = "" Then Beep: Exit Sub
                  F% = FreeFile
                  VA = Application.Trim(Range("A9", [A9].End(xlDown)).Value)

With Me.UsedRange.Columns
    If .Count > 1 Then .Item(2).Resize(, .Count - 1).Clear
End With
            Rows("5:" & UBound(VA) + 8).NumberFormat = "General"
                                                  C& = FC - 1
                          Application.ScreenUpdating = False
Do
     Open D & N For Input As #F
    SP = Split(Input(LOF(F), #F), vbNewLine)
                       Close #F
    If C Then K& = C + 1: C = 0
    ReDim CR(1 To 4)
                              M = Application.Match(TEST1, SP, 0)
           If IsError(M) Then M = Application.Match(TEST2, SP, 0)
     If IsNumeric(M) Then CR(4) = Split(SP(M), vbTab)(0)
                          CR(2) = Split(SP(0), vbTab)(0)
    If IsDate(CR(2)) Then CR(3) = CR(2)

    For Each V In SP
        If V Like "*CHECK_DATA*" Then
            S = Split(V, vbTab)
            M = Application.Match(Split(S(1))(1), VA, 0)
            If IsNumeric(M) Then COL(M + 4, 0) = S(2)

        ElseIf V Like "*PROCESS_DATA*" Then
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL: C = C + 1 Else C = K
            If C > Me.Columns.Count Then MsgBox "Max columns limit !", vbExclamation, "  Log import": Exit Do
            ReDim COL(1 To UBound(VA) + 4, 0)
            COL(1, 0) = CR(1):  COL(3, 0) = CR(3):  COL(4, 0) = CR(4)

        ElseIf V Like "SN:*" Then
            CR(1) = Left(Right(Split(V, vbTab)(0), 7), 4)
        End If
    Next
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL
           N = Dir$
Loop Until N = ""

With Cells(5, FC).CurrentRegion.Resize(UBound(COL))
                    .EntireColumn.AutoFit
                    .Rows(1).NumberFormat = "0000"
         .Rows("1:4").HorizontalAlignment = xlCenter
    With .Rows(4).FormatConditions
         .Delete:  .Add xlCellValue, xlNotEqual, "=""PASS"""
         .Item(1).Interior.ColorIndex = 22
    End With
End With
End Sub

This time, you may enjoy it ‼

cyliyu · Jul 12, 2015

Ya... This time I really enjoy it.
Thanks a lot.

If I wanted to fix row 7 to be "date" format, what would be the command? I tried but unsuccessful.

Marc L · Jul 12, 2015

cyliyu said:
The error message was due to the log file name started with P22 and P26...

Some "erratic" files but solved with this release :

Code:

Sub Demo2d()
Const FC = 4, TEST1 = "Test completed", TEST2 = TEST1 & vbTab & vbTab
  Dim COL(), SP$()

With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Select"
    .InitialFileName = ThisWorkbook.Path & "\"
        .InitialView = msoFileDialogViewList
              .Title = Space$(27) & "Choose the log files directory :"
    If .Show Then D$ = .SelectedItems(1) & "\" Else Exit Sub
End With
                  N$ = Dir$(D & "*.log"):  If N = "" Then Beep: Exit Sub
                  F% = FreeFile
                  VA = Application.Trim(Range("A9", [A9].End(xlDown)).Value)

With Me.UsedRange.Columns
    If .Count > 1 Then .Item(2).Resize(, .Count - 1).Clear
End With
            Rows("5:" & UBound(VA) + 8).NumberFormat = "General"
                                                  C& = FC - 1
                          Application.ScreenUpdating = False
Do
     Open D & N For Input As #F
    SP = Split(Input(LOF(F), #F), vbNewLine)
                       Close #F
    If C Then K& = C + 1: C = 0
    ReDim CR(1 To 4)
                              M = Application.Match(TEST1, SP, 0)
           If IsError(M) Then M = Application.Match(TEST2, SP, 0)
     If IsNumeric(M) Then CR(4) = Split(SP(M), vbTab)(0)
                          CR(2) = Split(SP(0), vbTab)(0)
    If IsDate(CR(2)) Then CR(3) = CR(2)

    For Each V In SP
        If V Like "*CHECK_DATA*" Then
            S = Split(Replace(V, vbTab, ""))
            M = Application.Match(S(1), VA, 0)
            If IsNumeric(M) Then COL(M + 4, 0) = S(3)

        ElseIf V Like "*PROCESS_DATA*" Then
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL: C = C + 1 Else C = K
            If C > Me.Columns.Count Then MsgBox "Max columns limit !", vbExclamation, "  Log import": Exit Do
            ReDim COL(1 To UBound(VA) + 4, 0)
            COL(1, 0) = CR(1):  COL(3, 0) = CR(3):  COL(4, 0) = CR(4)

        ElseIf V Like "SN:*" Then
            S = Split(V, vbTab)(0)
            If Len(S) < 7 Then CR(1) = Split(S, ":")(1) Else CR(1) = Left(Right(S, 7), 4)
        End If
    Next
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL
           N = Dir$
Loop Until N = ""

With Cells(5, FC).CurrentRegion.Resize(UBound(COL))
                    .EntireColumn.AutoFit
                    .Rows(1).NumberFormat = "0000"
         .Rows("1:4").HorizontalAlignment = xlCenter
    With .Rows(4).FormatConditions
         .Delete:  .Add xlCellValue, xlNotEqual, "=""PASS"""
         .Item(1).Interior.ColorIndex = 22
    End With
End With
End Sub

Like it ‼

Edit : no issue with date on my side !
Post a pic and tell me with which kind of log files (P22, P26, 91Q, …)
and attach your workbook, I will take a glance later …

cyliyu · Jul 12, 2015

Circled was what I mean.

Marc L · Jul 12, 2015

Maybe like this for dates
(and without ",USL" due to previous mod for erratic files) :

Code:

Sub Demo2e()
Const FC = 4, TEST1 = "Test completed", TEST2 = TEST1 & vbTab & vbTab
  Dim COL(), SP$()

With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Select"
    .InitialFileName = ThisWorkbook.Path & "\"
        .InitialView = msoFileDialogViewList
              .Title = Space$(27) & "Choose the log files directory :"
    If .Show Then D$ = .SelectedItems(1) & "\" Else Exit Sub
End With
                  N$ = Dir$(D & "*.log"):  If N = "" Then Beep: Exit Sub
                  F% = FreeFile
                  VA = Application.Trim(Range("A9", [A9].End(xlDown)).Value)

With Me.UsedRange.Columns
    If .Count > 1 Then .Item(2).Resize(, .Count - 1).Clear
End With
            Rows("5:" & UBound(VA) + 8).NumberFormat = "General"
                                                  C& = FC - 1
                          Application.ScreenUpdating = False
Do
     Open D & N For Input As #F
    SP = Split(Input(LOF(F), #F), vbNewLine)
                       Close #F
    If C Then K& = C + 1: C = 0
    ReDim CR(1 To 4)
                              M = Application.Match(TEST1, SP, 0)
           If IsError(M) Then M = Application.Match(TEST2, SP, 0)
     If IsNumeric(M) Then CR(4) = Split(SP(M), vbTab)(0)
                          CR(2) = Split(SP(0), vbTab)(0)
    If IsDate(CR(2)) Then CR(3) = CR(2)

    For Each V In SP
        If V Like "*CHECK_DATA*" Then
            S = Split(Replace(V, vbTab, ""))
            M = Application.Match(S(1), VA, 0)
            If IsNumeric(M) Then COL(M + 4, 0) = Split(S(3), ",")(0)

        ElseIf V Like "*PROCESS_DATA*" Then
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL: C = C + 1 Else C = K
            If C > Me.Columns.Count Then MsgBox "Max columns limit !", vbExclamation, "  Log import": Exit Do
            ReDim COL(1 To UBound(VA) + 4, 0)
            COL(1, 0) = CR(1):  COL(3, 0) = CR(3):  COL(4, 0) = CR(4)

        ElseIf V Like "SN:*" Then
            S = Split(V, vbTab)(0)
            If Len(S) < 7 Then CR(1) = Split(S, ":")(1) Else CR(1) = Left(Right(S, 7), 4)
        End If
    Next
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL
           N = Dir$
Loop Until N = ""

With Cells(5, FC).CurrentRegion.Resize(UBound(COL))
                    .EntireColumn.AutoFit
                    .Rows(1).NumberFormat = "0000"
                    .Rows(3).NumberFormat = "m/d/yyyy"
         .Rows("1:4").HorizontalAlignment = xlCenter
    With .Rows(4).FormatConditions
         .Delete:  .Add xlCellValue, xlNotEqual, "=""PASS"""
         .Item(1).Interior.ColorIndex = 22
    End With
End With
End Sub

If you like …

cyliyu · Jul 12, 2015

Demo2e solved the problem. Thank you so much.

Marc L · Jul 12, 2015

f release for final optimization (?) :

Code:

Sub Demo2f()
Const FC = 4:    Dim COL(), SP$()

With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Select"
    .InitialFileName = ThisWorkbook.Path & "\"
        .InitialView = msoFileDialogViewList
              .Title = Space$(27) & "Choose the log files directory :"
    If .Show Then D$ = .SelectedItems(1) & "\" Else Exit Sub
End With
                  N$ = Dir$(D & "*.log"):  If N = "" Then Beep: Exit Sub
                  F% = FreeFile
                  VA = Application.Trim(Range("A9", [A9].End(xlDown)).Value)

With Me.UsedRange.Columns
    If .Count > 1 Then .Item(2).Resize(, .Count - 1).Clear
End With
            Rows("5:" & UBound(VA) + 8).NumberFormat = "General"
                                                  C& = FC - 1
                          Application.ScreenUpdating = False
Do
     Open D & N For Input As #F
    SP = Split(Input(LOF(F), #F), vbNewLine)
                       Close #F
    If C Then K& = C + 1: C = 0
    ReDim CR(1 To 4)
                             M = Application.Match("Test completed*", SP, 0)
    If IsNumeric(M) Then CR(4) = Split(SP(M), vbTab)(0)
                             S = Split(SP(0), vbTab)(0)
       If IsDate(S) Then CR(3) = S
                             M = Application.Match("SN:*", SP, 0)
    If IsNumeric(M) Then
                             S = Split(SP(M - 1), vbTab)(0)
      If Len(S) < 7 Then CR(1) = Mid(S, 5) Else CR(1) = Left(Right(S, 7), 4)
    End If

    For Each V In SP
        If V Like "*CHECK_DATA*" Then
            S = Split(Replace(V, vbTab, ""))
            M = Application.Match(S(1), VA, 0)
            If IsNumeric(M) Then COL(M + 4, 0) = Split(S(3), ",")(0)

        ElseIf V Like "*PROCESS_DATA*" Then
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL: C = C + 1 Else C = K
            If C > Me.Columns.Count Then MsgBox "Max columns limit !", vbExclamation, "  Log import": Exit Do
            ReDim COL(1 To UBound(VA) + 4, 0)
            COL(1, 0) = CR(1):  COL(3, 0) = CR(3):  COL(4, 0) = CR(4)
        End If
    Next
            If C Then Cells(5, C).Resize(UBound(COL)).Value = COL
           N = Dir$
Loop Until N = ""

With Cells(5, FC).CurrentRegion.Resize(UBound(COL))
                    .EntireColumn.AutoFit
                    .Rows(1).NumberFormat = "0000"
                    .Rows(3).NumberFormat = "m/d/yyyy"
         .Rows("1:4").HorizontalAlignment = xlCenter
    With .Rows(4).FormatConditions
         .Delete:  .Add xlCellValue, xlNotEqual, "=""PASS"""
         .Item(1).Interior.ColorIndex = 22
    End With
End With
End Sub

cyliyu · Jul 12, 2015

Thanks again.

Marc L · Jul 12, 2015

You're welcome !

Application.Trim and Application.Match are not VBA functions
but Excel ones, so refer to Excel help.
All others statements are available in VBA help …

VA array variable is an inner dictionary of the 50 data to extract,
SP array variable contains the log file lines.
Match Excel function is used to check if a data exists in an array …

Dictionary object (available only under Windows, see in VBA help or MSDN)
is well known for its velocity. If you're interested in, I could give it a try …

cyliyu · Jul 12, 2015

Thanks for the great explanation.
Just started learning coding, long way to go, especially to get word from experience programmer like you.
I have gathered much knowledge for the past 2 days. I'm always willing to learn new things. Thanks.

Marc L · Jul 12, 2015

External Dictionary fastest way :

Code:

Sub Demo3()
Const FC = 4:    Dim COL()

With Application.FileDialog(msoFileDialogFolderPicker)
         .ButtonName = "Select"
    .InitialFileName = ThisWorkbook.Path & "\"
        .InitialView = msoFileDialogViewList
              .Title = Space$(27) & "Choose the log files directory :"
    If .Show Then D$ = .SelectedItems(1) & "\" Else Exit Sub
End With
                  N$ = Dir$(D & "*.log"):  If N = "" Then Beep: Exit Sub
                  F% = FreeFile
                  SP = Application.Trim(Range("A9", [A9].End(xlDown)).Value)
                  U& = UBound(SP) + 4

With Me.UsedRange.Columns
    If .Count > 1 Then .Item(2).Resize(, .Count - 1).Clear
End With
            Rows(5).Resize(U).NumberFormat = "General"
                                        C& = FC - 1
                Application.ScreenUpdating = False

With CreateObject("Scripting.Dictionary")
        For K& = 1 To UBound(SP):  .Item(SP(K, 1)) = K + 4:  Next
    Do
        Open D & N For Input As #F
        SP = Split(Input(LOF(F), #F), vbNewLine)
                          Close #F
        If C Then K = C + 1: C = 0
        ReDim CR(1 To 4)
                                 M = Application.Match("Test completed*", SP, 0)
        If IsNumeric(M) Then CR(4) = Split(SP(M), vbTab)(0)
                                 S = Split(SP(0), vbTab)(0)
           If IsDate(S) Then CR(3) = S
                                 M = Application.Match("SN:*", SP, 0)
        If IsNumeric(M) Then
                                 S = Split(SP(M - 1), vbTab)(0)
         If Len(S) < 11 Then CR(1) = Mid(S, 5) Else CR(1) = Left(Right(S, 7), 4)
        End If

        For Each V In SP
            If V Like "*CHECK_DATA*" Then
                S = Split(Replace(V, vbTab, ""))
                If .Exists(S(1)) Then COL(.Item(S(1)), 0) = Split(S(3), ",")(0)

            ElseIf V Like "*PROCESS_DATA*" Then
                If C Then Cells(5, C).Resize(UBound(COL)).Value = COL: C = C + 1 Else C = K
                If C > Me.Columns.Count Then MsgBox "Max columns limit !", vbExclamation, "  Log import": Exit Do
                ReDim COL(1 To U, 0):  COL(1, 0) = CR(1):  COL(3, 0) = CR(3):  COL(4, 0) = CR(4)
            End If
        Next
                If C Then Cells(5, C).Resize(UBound(COL)).Value = COL
               N = Dir$
    Loop Until N = ""
                        .RemoveAll
End With

With Cells(5, FC).CurrentRegion.Resize(U)
                    .EntireColumn.AutoFit
                    .Rows(1).NumberFormat = "0000"
                    .Rows(3).NumberFormat = "m/d/yyyy"
         .Rows("1:4").HorizontalAlignment = xlCenter
    With .Rows(4).FormatConditions
         .Delete:  .Add xlCellValue, xlNotEqual, "=""PASS"""
         .Item(1).Interior.ColorIndex = 22
    End With
End With
End Sub

Test it, enjoy it and like it !

_________________________________________________________________

We are all very ignorant, what happens is that not all ignore the same things …

Albert Einstein

cyliyu · Jul 12, 2015

brilliant, the code Demo 3 work perfectly. Thanks.

Marc L · Jul 13, 2015

Faster (at least 2 times) ? So you should like it !

First element of an array from a cells Range is #1. (codeline #13)
First element of an array from Split function is #0 …
Match Excel function for a found element returns its position in array,
not its index within this array.

For example with SP array variable loaded with log file lines (codeline #27)
Match returns #3 position for "SN:*" in this array (codeline #35).
But like first array index is #0, SN line is the array index #2 (codeline #37).

You can check during code execution via a break point or in step by step
mode (hit F8 key to progress in code) the Local variables window …

See also LBound and UBound functions for lower and upper array indexes.

Dictionary object codelines :

#24 : loading elements to extract (key)

with index within COL array variable (item).

#44 : updating COL if an element from log file exists in dictionary.

#55 : erase dictionary …

cyliyu · Jul 13, 2015

Thanks for the knowledge sharing.
I have a question.
If the code FC was set to 4, can I don't clear the spreadsheet from B column onward? Leave the column A, B and C as it is?

Marc L · Jul 13, 2015

Yes you can ‼ (beginner level)

From original codeline #17

If .Count > 1 Then .Item(2).Resize(, .Count - 1).Clear

respecting TBTO rule amend it like this:

If .Count >= FC Then .Item(FC).Resize(, .Count - FC + 1).Clear …

cyliyu · Jul 13, 2015

Thanks.
I almost got it but didn't replace .Item(2) to .Item(FC)

Extract Data From Text File into Excel using VBA or a Macro?

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member

Excel Ninja

Member