Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 368
  • Last Modified:

Use values in Excel column to read text file and output results

I have the need to read the values from an excel column and use each value to perform a search in a respective text file.   Then highlight every value in column A in RED that is not found during the search of the text file?  This way, after I run the macro I can simply do a filter on color in column A to show all those in red :)  All the search values will come from the column A.  

Because I want to use the values in column A to search a text file, I did not think I could use a standard VLookup, I may be wrong.

I would like to do this programatically within an Excel Macro using VB.


Excel File A
Text File A
0
66chawger
Asked:
66chawger
  • 6
  • 4
1 Solution
 
krishnakrkcCommented:
Hi

Try this

Option Explicit

Sub kTest()
    
    Dim ka, i       As Long
    Dim txt         As String
    Dim Fldr        As String
    Dim FName       As String
    Dim fso         As Object
    Dim x, j        As Long
    Dim wksResult   As Worksheet
    Dim dic         As Object
    
    ka = Range("a1:a" & Range("a" & Rows.Count).End(3).Row).Value2
    
    Fldr = "C:\test"
    
    If Right(Fldr, 1) <> "\" Then Fldr = Fldr & "\"
    
    FName = Dir(Fldr & "*.txt")
    Set fso = CreateObject("scripting.filesystemobject")
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    
    For i = 2 To UBound(ka, 1) 'skip header row
        If Len(ka(i, 1)) Then dic.Item(ka(i, 1)) = False
    Next
    
    Do While FName <> vbNullString
        txt = fso.opentextfile(Fldr & FName).readall
        x = Split(txt, vbLf)
        For j = 0 To UBound(x)
            Debug.Print x(j)
            For i = 2 To UBound(ka, 1)
                If dic.Item(ka(i, 1)) = False Then
                    If InStr(1, x(j), ka(i, 1), 1) Then
                        dic.Item(ka(i, 1)) = True
                    End If
                End If
            Next
        Next
        txt = vbNullString
        FName = Dir()
    Loop
    
    x = Array(dic.keys, dic.items)
    
    On Error Resume Next
    Set wksResult = Worksheets("Results_")
    On Error GoTo 0
    
    If wksResult Is Nothing Then
        Set wksResult = Worksheets.Add
        wksResult.Name = "Results_"
    End If
    j = 1
    With wksResult
        .UsedRange.ClearContents
        .Range("a1") = "Words not found"
        For i = 0 To UBound(x(0))
            If Not x(1)(i) Then
                j = j + 1
                .Range("a" & j) = x(0)(i)
            End If
        Next
    End With
    
End Sub

Open in new window


Kris
0
 
66chawgerAuthor Commented:
Kris,

Thanks for the response.  A few questions:  Would I just put this in a MACRO in excel?  Fldr = "C:\test"  would be the path and prefix for the text file, correct?
0
 
krishnakrkcCommented:
Hi

Hit Alt + F11 > Insert > Module and paste the code there.

Fldr = "C:\test"  would be the path and prefix for the text file, correct?

Yes

Kris
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
66chawgerAuthor Commented:
Kris,

I was able to load and run the code, however, running into either an infinite loop or other issue in the following section:

>> I think here you are building a list of all the cells in column A less the header, correct?.. I assume for an array

For i = 2 To UBound(ka, 1) 'skip header row
        If Len(ka(i, 1)) Then dic.Item(ka(i, 1)) = False
    Next
   
>> The next Do  While is the loop where I am getting in an infinite loop.  I did want to let you know that this is just one text file and it is HUGE.  I assume the following readall is loading the text file w/ the CRLF in an array, correct?  Is there anyway once the document is open to do a standard "FIND" using the variables in the array above?  I am also assuming  you are creating a separate worksheet "Results" with any of the variables in the column A array that are not found in the text file, correct?  Don't know if this will help, but the following is an example of where the target search will be located in the text file, i.e., I don't know if we can limit the search to just these "BHT" records...

BHT*0019*00*PAS.BHT...0001*CRE8DATE*124824*CH~

<<<<


    Do While FName <> vbNullString
        txt = fso.opentextfile(Fldr & FName).readall
        x = Split(txt, vbLf)
        For j = 0 To UBound(x)
            Debug.Print x(j)
            For i = 2 To UBound(ka, 1)
                If dic.Item(ka(i, 1)) = False Then
                    If InStr(1, x(j), ka(i, 1), 1) Then
                        dic.Item(ka(i, 1)) = True
                    End If
                End If
            Next
        Next
        txt = vbNullString
        FName = Dir()
    Loop
0
 
66chawgerAuthor Commented:
I think I need another way out of the loop other than checking FName <> vbNullString..  Maybe at the end of the ka array (column array)
0
 
krishnakrkcCommented:
Could you post a cut down version of your text file ?
0
 
66chawgerAuthor Commented:
Kris,

Attached is a cut down version of the file.  Sorry getting posted so late, out sick yesterday.  Anyway, this is a segmented file.  Each line is a separate record, with the exception of the first two which comprises a header record.  The search target will always be in the third element of the BHT records...

Example:
BHT*0019*00*PAS1000A.NM1...0001*CRE8DATE*124824*CH~

I think your original code will work fine, I just need a different variable for the do while then "while file <> vbnullstring.  Simply because I hard coded the file name instead of using "*.txt".  This is why I asked if we could terminate the loop once the ka array index is greater than i?
text.txt
0
 
krishnakrkcCommented:
Hi

try

Option Explicit

Sub kTest()
    
    Dim ka, i       As Long
    Dim txt         As String
    Dim FName       As String
    Dim fso         As Object
    Dim x, j        As Long
    Dim wksResult   As Worksheet
    Dim dic         As Object
    
    ka = Range("a1:a" & Range("a" & Rows.Count).End(3).Row).Value2
    
    FName = "C\text.txt"
    
    Set fso = CreateObject("scripting.filesystemobject")
    Set dic = CreateObject("scripting.dictionary")
        dic.comparemode = 1
    
    For i = 2 To UBound(ka, 1) 'skip header row
        If Len(ka(i, 1)) Then dic.Item(ka(i, 1)) = False
    Next
    
    txt = fso.opentextfile(Fldr & FName).readall
    x = Split(txt, vbLf)
    For j = 0 To UBound(x)
        'look only lines where BHT exists
        If InStr(1, x(j), "BHT", 1) Then
            For i = 2 To UBound(ka, 1)
                If dic.Item(ka(i, 1)) = False Then
                    If InStr(1, x(j), ka(i, 1), 1) Then
                        dic.Item(ka(i, 1)) = True
                    End If
                End If
            Next
        End If
    Next
    
    x = Array(dic.keys, dic.items)
    
    On Error Resume Next
    Set wksResult = Worksheets("Results_")
    On Error GoTo 0
    
    If wksResult Is Nothing Then
        Set wksResult = Worksheets.Add
        wksResult.Name = "Results_"
    End If
    j = 1
    With wksResult
        .UsedRange.ClearContents
        .Range("a1") = "Words not found"
        For i = 0 To UBound(x(0))
            If Not x(1)(i) Then
                j = j + 1
                .Range("a" & j) = x(0)(i)
            End If
        Next
    End With
    
End Sub

Open in new window


Kris
0
 
66chawgerAuthor Commented:
Kris, Thanks for the update.  I will test.
0
 
Martin LissRetired ProgrammerCommented:
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0
 
66chawgerAuthor Commented:
Kris, I apologize for not getting back to this post and am glad the admin awarded you the points.  Had some personal issues and was out of the loop.  Thanks again!
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

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