Consulting

Results 1 to 5 of 5

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

  1. #1

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

    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

  2. #2
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  3. #3
    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 ?

  4. #4
    Moderator VBAX Master georgiboy's Avatar
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    1,158
    Location
    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
    Click here for a guide on how to add code tags
    Click here for a guide on how to mark a thread as solved

    Excel 365, Version 2401, Build 17231.20084

  5. #5
    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 ?

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •