yesIamFaded
yesIamFaded

Reputation: 2068

Excel VBA Loop through files with a given String

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

Upvotes: 0

Views: 863

Answers (1)

CDP1802
CDP1802

Reputation: 16357

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

Upvotes: 1

Related Questions