Solved

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

Posted on 2012-09-17
318 Views
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
Question by:66chawger

LVL 18

Expert Comment

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
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
wksResult.Name = "Results_"
End If
j = 1
With wksResult
.UsedRange.ClearContents
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


Kris
0

Author Comment

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

LVL 18

Expert Comment

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

Author Comment

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

Author Comment

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

LVL 18

Expert Comment

Could you post a cut down version of your text file ?
0

Author Comment

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

LVL 18

Accepted Solution

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

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
wksResult.Name = "Results_"
End If
j = 1
With wksResult
.UsedRange.ClearContents
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


Kris
0

Author Comment

Kris, Thanks for the update.  I will test.
0

LVL 44

Expert Comment

This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Author Comment

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

### Suggested Solutions

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.