VBA - Search all folders for datal/text

[Lunzwe73]

Hello all! I have VBA code in a macro that searches for text in multiple worksheets in workbooks and all folders and creates a new worksheet with 4 columns. The 4 columns returned are workbook Name, Worksheet Name, Cell Address and Text Found. In the VBA code (screeshot1), strPath is the path where my folder "Data Flow Analysis Tracker" is located and it has multiple workbooks which I want to search for particular text. When I use the strPath in the code, I'm getting the error message in the code highlighted in yellow SCREENSHOT1). But when i change the strPath to a folder that does not exist i.e strPath = "C:\MyExcelData", the code seems to work only the folder specified does not exist.

If anyone can help me fix this, I will be very greatful. The full vba code is below as well as screenshots

Sub SearchAllFolders()
Dim strSearch As String
Dim strPath As String
Dim strFile As String
Dim wksReport As Worksheet
Dim wbk As Workbook
Dim wks As Worksheet
Dim StartRow As Long
Dim ringFound As Range
Dim strFirstAddress As String

Application.ScreenUpdating = False

strPath = "C:\MyExcelData"
strSearch = Application.InputBox("Enter the text to search", "My choice of text", "Enter Search Text", vbOKCancel)
If strSearch = "False" Then Exit Sub
Set wksReport = Worksheets.Add
StartRow = 1
With wksReport
           .Cells(StartRow, 1) = "Workbook"
           .Cells(StartRow, 2) = "Worksheet"
           .Cells(StartRow, 3) = "Cell Address"
           .Cells(StartRow, 4) = "Test Found"

strFile = Dir(strPath & "\*.xls*")
Do While strFile <> ""
Set wbk = Workbookd.Open(Filename:=strPath & "\" & strFile)
            For Each wks In wbk.worksheeks
            Set ringFound = wks.UsedRange.Find(strSearch)
            If Not ringFound Is Nothing Then
                       strFirstAddress = ringFound.Address
           End If

           Do
             
                If ringFound Is Nothing Then
                               Exit Do
               Else
                           StartRow = StartRow + 1
                           .Cells(StartRow, 1) = wbk.Name
                           .Cells(StartRow, 2) = wks.Name
                           .Cells(StartRow, 3) = ringFound.Address
                           .Cells(StartRow, 4) = ringFound.Value
End If

Set ringFound = wks.Cells.FindNext(after:=ringFound)

Loop While strFirst <> ringFound.Address
Next
wkb.Cose (False)
strFile = Dir

Loop
   Columns("A:D").EntireColumn.AutoFit
End With
If wksReport.Cells(2, 1) = "" Then
            MsgBox "All Excel Files In Folder Searched!" & vbCrLf & "No data found!"
            Cells(StartRow, 1) = " "
            Cells(StartRow, 2) = " "
            Cells(StartRow, 3) = " "
            Cells(StartRow, 4) = " "

On Error Resume Next
Application.DisplaysAlert = False
wksReportr.Delete

Else

MsgBox "All Excel files in folder searched. " & vbCrLf & "Data Extracted."

End If
Set wksReport = Nothing
Set wks = Nothing
Set wkb = Nothing

Application.ScreenUpdating = True
Application.DisplaysAlerts = True

    Range("B19").Select
    Sheets("Step 1- data flow analysis").Select
    Range("A8").Select
    ActiveCell.FormulaR1C1 = "Probability of Default"
End Sub

SCREENSHOT1

SCREENSHOT2

 

[MikeVol]

Hi. Maybe:

strFile = Dir(strPath & "\" & *.xls*")

 

[MikeVol]

Please consider the above post to be invalid. Make sure that you really have such a folder with the specified name at this path. To check if such a folder exists, run the following code:

Option Explicit

Sub FindExcelFiles()
    
    ' Set strPath to your directory path
    ' Change to your real directory
    Dim strPath     As String: strPath = "C:\Users\Mike\Documents\"

    ' Checking the existence of a directory
    If Dir(strPath, vbDirectory) = "" Then
        MsgBox "Directory does not exist."
        Exit Sub
    Else
        MsgBox "The directory you specified exists! "
    End If

    ' Search for .xls* files
    Dim strFile     As String: strFile = Dir(strPath & "\*.xls*")

    ' Checking for files
    If strFile = "" Then
        MsgBox ".xls* files not found."
        Exit Sub
    Else
        MsgBox "The .xls* files exist in the directory you specified! "
    End If

    '    ' Iterate through all found files
    '    Do While strFile <> ""

    '        ' File actions (for example, displaying the file name)
    '        MsgBox "File found: " & strFile

    '        ' Move to next file
    '        strFile = Dir
    '    Loop

End Sub

After you receive a positive answer, make the necessary changes to your code. Perhaps you did not specify the full path to the directory correctly or you do not have such a directory. Good luck.

 

[rlv01]

Hello all! I have VBA code in a macro that searches for text in multiple worksheets in workbooks

When I tried to compile your code I encountered many errors. Mis-spellings and other typos that would prevent your posted code from ever working. I recommend as a first step is that you go back and add an Option Explicit statement at the top or your code module, then recompile to fix your variable errors.

How to post your code using code tags:

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

 

[MikeVol]

I tested your code. There were some spelling errors in it, corrected. For the test, I created a folder "Test_v2" (C:\Users\Mike\Documents\Test_v2\), threw several books into it and the code worked without errors.

Option Explicit

Sub SearchAllFolders()
    Dim strSearch As String, strPath As String, strFile As String, strFirstAddress As String
    Dim wksReport As Worksheet, wks As Worksheet
    Dim wbk         As Workbook
    Dim StartRow    As Long
    Dim ringFound   As Range

    Application.ScreenUpdating = False

    strPath = "C:\Users\Mike\Documents\Test_v2\"
    '    strPath = "C:\MyExcelData"
    strSearch = Application.InputBox("Enter the text to search", "My choice of text", "Enter Search Text", vbOKCancel)
    If strSearch = "False" Then Exit Sub
    Set wksReport = Worksheets.Add
    StartRow = 1

    With wksReport
        .Cells(StartRow, 1) = "Workbook"
        .Cells(StartRow, 2) = "Worksheet"
        .Cells(StartRow, 3) = "Cell Address"
        .Cells(StartRow, 4) = "Test Found"

        strFile = Dir(strPath & "\*.xls*")

        Do While strFile <> ""
            Set wbk = Workbooks.Open(Filename:=strPath & "\" & strFile)

            For Each wks In wbk.Worksheets
                Set ringFound = wks.UsedRange.Find(strSearch)

                If Not ringFound Is Nothing Then
                    strFirstAddress = ringFound.Address
                End If

                Do

                    If ringFound Is Nothing Then
                        Exit Do
                    Else
                        StartRow = StartRow + 1
                        .Cells(StartRow, 1) = wbk.Name
                        .Cells(StartRow, 2) = wks.Name
                        .Cells(StartRow, 3) = ringFound.Address
                        .Cells(StartRow, 4) = ringFound.Value
                    End If

                    Set ringFound = wks.Cells.FindNext(after:=ringFound)

                Loop While strFirstAddress <> ringFound.Address

            Next

            wbk.Close False
            strFile = Dir
        Loop

        Columns("A:D").EntireColumn.AutoFit
    End With

    If wksReport.Cells(2, 1) = "" Then
        MsgBox "All Excel Files In Folder Searched!" & vbCrLf & "No data found!"
        wksReport.Cells(StartRow, 1) = " "
        wksReport.Cells(StartRow, 2) = " "
        wksReport.Cells(StartRow, 3) = " "
        wksReport.Cells(StartRow, 4) = " "

        On Error Resume Next
        Application.DisplaysAlert = False
        wksReport.Delete
        Application.DisplaysAlerts = True
        On Error GoTo 0
    Else
        MsgBox "All Excel files in folder searched. " & vbCrLf & "Data Extracted."
    End If

    With Sheets("Step 1- data flow analysis")
        .Range("A8").FormulaR1C1 = "Probability of Default"
    End With

    Set wksReport = Nothing
    Set wks = Nothing
    Set wbk = Nothing

    Application.ScreenUpdating = True
End Sub