Excel VBA Loop through files with a given String

Question

I need to create an Excel VBA Macro that is able to Loop through some Files and if it finds the given String it should fill the Excel Worksheet where I need to.

Currently it looks like this: I show a UserForm that has a TextBox where the String gets entered and a Button.

If the User clicks on that Button then the files should get looped through and if it finds the string in one of that files it should enter something new to the excel where the macro is called from.

I have searched on SO but with no Luck, I found this:

Sub LoopThroughFiles()                                                 
    Dim StrFile As String
    StrFile = Dir("C:\Users\xxx\xxx\xxx\test\*test*")
    Do While Len(StrFile) > 0
        Debug.Print StrFile
        StrFile = Dir
    Loop
End Sub

But this looks like it loops and looks if the filename has test in it and not if the actual file has a Value that is called "test".

Also the string that needs to be found is always in the first column of the files. And I would have to read the second column in that activeCell that I would get if the String is found and add that to the Excel where I call this Macro from.

Sincerly Faded ~

Edit:

Sub ReadDataFromAnotherWorkBook()

    ' Open Workbook A with specific location
    Dim src As Workbook
    Set src = Workbooks.Open("C:\Users\xxx\Desktop\xxx\test\x1x.xlsx", True, True)                 

    Dim valueBookA As String
    Dim valueBookB As Integer

    valueBookA = src.Worksheets("Tabelle1").Cells(2, 1)      ' Works but here I need to put the enteredValue and search for it
    Cells(1, 1).Value = valueBookA

    ' Close Workbooks A
    src.Close False
    Set src = Nothing

     ' Dialog Answer
    MsgBox valueBookA
End Sub

This gives me a Value from the read Excel which is good as a first start. I need to loop that to open up more files and also I need the part where I can search for the given String and get the value in that row.

Edit2:

This is what I have now but I cant get the value.. what am I doing wrong :/

Sub ReadDataFromAnotherWorkBook()

    Dim SearchString As String
    Dim SearchRange As Range, cl As Range
    Dim FirstFound As String
    Dim sh As Worksheet

    ' Open Workbook A with specific location
    Dim src As Workbook
    Set src = Workbooks.Open("C:\Users\x\Desktop\xxx\test\xxx.xlsx", True, True)
    
        ' Set Search value
    SearchString = TextBox1.Value                                   ' TEST mit TextBox Value -- works
    Application.FindFormat.Clear
    ' loop through all sheets
    For Each sh In src.Worksheets
        ' Find first instance on sheet
        Set cl = sh.Cells.Find(What:=SearchString, _
            After:=sh.Cells(1, 1), _
            LookIn:=xlValues, _
            LookAt:=xlPart, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, _
            MatchCase:=False, _
            SearchFormat:=False)
        If Not cl Is Nothing Then
            ' if found, remember location
            FirstFound = cl.Address
            MsgBox FirstFound
            ' format found cell
            Do
              '  cl.Font.Bold = True
              '  cl.Interior.ColorIndex = 3
              Debug.Print FirstFound
              MsgBox FirstFound                                             ' Does not work..
              
'              Debug.Print cl.Value
               MsgBox cl.Value                                              ' Also does not work -- I need the VALUE that is in the Excel Row or Column where the string gets found
                ' find next instance
                Set cl = sh.Cells.FindNext(After:=cl)
                ' repeat until back where we started
            Loop Until FirstFound = cl.Address
        End If
    Next
    
    MsgBox "Value in Excel? : " + FirstFound                               'cl.Value            > Is empty..

    MsgBox "SEARCHSTRING :: " + SearchString                               ' Gives me the right String

    ' Close Workbooks A                                                    ' Closes the Workbook
    src.Close False
    Set src = Nothing

End Sub

What do you mean it looks like? Have you tested it yet? Also, to find a cell use Range("A:A").Find(..... If you set this as a Range variable you can test if anything was found and use Offset(1) to get to the value in second column next to found cell — urdearboy
– urdearboy, Commented Mar 18, 2021 at 15:08
Dir list files where the name matches a pattern. You want to look into the files to search for the text, you need a different approach. If it is text files, look at stackoverflow.com/questions/17275040/…. But as you talk about a Column, I assume you are talking about Excel files. You will need to open them to look for the text — FunThomas
– FunThomas, Commented Mar 18, 2021 at 15:17
Yes - there are like 3 or 4 Excel Files that need to get searched if they contain the given string — yesIamFaded
– yesIamFaded, Commented Mar 19, 2021 at 7:18

CDP1802 · Accepted Answer · 2021-03-22 08:16:05Z

1

Use Dir to loop over the files in turn

Sub SearchFiles()

    Const FOLDER = "C:\Users\xxx\Desktop\xxx\test\"
    
    Dim wb As Workbook, wbSrc As Workbook
    Dim ws As Worksheet, wsSrc As Worksheet
    Dim sText As String, sFilename As String
    Dim cell As Range, rng As Range
    Dim n As Long, i As Long, FirstFound As String

    sText = TextBox1.Value

    ' location of search results
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1) ' results of search
    ws.Cells.Clear
    ws.Range("A1:B1") = Array("Search Test = ", sText)
    ws.Range("A2:C2") = Array("Address", "Col A", "Col B")
    ws.Range("A2:C2").Font.Bold = True
    i = 3
    
    ' scan all xlsx files in folder
    sFilename = Dir(FOLDER & "*.xlsx")
    Do While Len(sFilename) > 0
        Set wbSrc = Workbooks.Open(FOLDER & sFilename, True, True)
        For Each wsSrc In wbSrc.Sheets
            n = n + 1
            Set rng = wsSrc.Columns(1)
            Set cell = rng.Find(What:=sText, _
                After:=rng.Cells(1, 1), _
                LookIn:=xlValues, _
                LookAt:=xlPart, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False, _
                SearchFormat:=False)
             
             ' text found
             If Not cell Is Nothing Then
                FirstFound = cell.Address
                Do ' update sheet
                    ws.Cells(i, 1) = cell.Address(0, 0, xlA1, True)
                    ws.Cells(i, 2) = cell
                    ws.Cells(i, 3) = cell.Offset(0, 1)
                    i = i + 1
                    Set cell = rng.FindNext(After:=cell)
                    ' repeat until back where we started
                Loop Until FirstFound = cell.Address
             End If
        Next
        wbSrc.Close
        sFilename = Dir
    Loop
    MsgBox n & " sheets scanned", vbInformation
 End Sub

edited Mar 22, 2021 at 8:16

answered Mar 20, 2021 at 13:10

CDP1802

17.3k2 gold badges10 silver badges19 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

yesIamFaded Over a year ago

I went with this anwser for now: stackoverflow.com/questions/66706661/… - I think I might look into your filesloop part tho because that seems to work, but in generall if I run your function it destroyes my excelsheet. Thanks!

CDP1802 Over a year ago

@yeslam Change this line Set ws = wb.Sheets(1) to another sheet where you want the results displayed.

Collectives™ on Stack Overflow

Excel VBA Loop through files with a given String

1 Answer 1

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related