macros to search for string in cell from text files under folder & return no of count

[mrshiseido]

hi i am newbie in VBA & would like a macros to able to search for string in cell column among text files under a folder & then return no of count in excel

I would be much appreciated if any can give me some guideline & kick start. Thx

[georgiboy]

Hi there, welcome to the forum.

It really would depend on how the data in the text files is formatted (are all the text files the same? Is it written like a story, with punctuation?)

Below is an example of looping through lookup data in sheet1 starting as range (A2),
Looping through a folder with text files only,
Open each text file and loop through the rows of data,
Count the word found in our sheet1 lookup data,
Close the text file file,
Place the counted value in column B next to the lookup value.

Note: This is based on a text file with only one word per line as data.


Sub SearchString()
Dim SrchStrRng As Range, rCell As Range, x As Long
Dim strLine As String, rPath As String, fileName As Variant


Set SrchStrRng = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
rPath = "C:\Users\A\Desktop\testFolder\"

For Each rCell In SrchStrRng.Cells
fileName = Dir(rPath)

While fileName <> ""
Open rPath & fileName For Input As #1
While EOF(1) = False
Line Input #1, strLine
If strLine = rCell.Value Then
x = x + 1
End If
Wend
Close #1
fileName = Dir
Wend

rCell.Offset(, 1).Value = x
x = 0
Next rCell

End Sub

Hope this helps

[mrshiseido]

thx, your prompt feedback is highly appreciated.

in the raw text files where string to are to be looked up, there are more than one words on each row/line, which are randomly separated by space, so is there any modification required in the code above ?

[georgiboy]

There are many ways of doing this, here is an updated example:
Someone else may have a different idea.


Sub SearchString()
Dim SrchStrRng As Range, rCell As Range, x As Long
Dim strLine As String, rPath As String, fileName As Variant
Dim WordVar As Variant, WordLoop As Long

Set SrchStrRng = Sheet1.Range("A2:A" & Sheet1.Range("A" & Rows.Count).End(xlUp).Row)
rPath = "C:\Users\A\Desktop\testFolder\"

For Each rCell In SrchStrRng.Cells
fileName = Dir(rPath)

While fileName <> ""
Open rPath & fileName For Input As #1
While EOF(1) = False
Line Input #1, strLine
WordVar = Split(strLine, " ")
For WordLoop = 0 To UBound(WordVar)
If IsLetter(Application.Trim(WordVar(WordLoop))) = rCell.Value Then
x = x + 1
End If
Next WordLoop
Wend
Close #1
fileName = Dir
Wend

rCell.Offset(, 1).Value = x
x = 0
Next rCell

End Sub


Function IsLetter(strVal As String)
Dim x As Integer
Dim str As String

For x = 1 To Len(strVal)
Select Case Asc(Mid(strVal, x, 1))
Case 65 To 90, 97 To 122
str = str & Mid(strVal, x, 1)
End Select
IsLetter = str
Next
End Function

Hope this helps

[mrshiseido]

thx for your feedback , however, since the text files are pretty large (4Mb) , in which it is taking ages to run macro & actually freezing up excel whenever i tried to run it with the code above. The string that is to be lookup is in fact mac address which not only composed of letter but also numbers seperated by ".", so i have added the ascii range 48-57 + 46 as well but seems like the result is not what I expected.. (failed to count properly, hit count is always 0") any idea ?