I was doing some more research on this issue and found this:
https://www.get-digital-help.com/sea...d-sub-folders/
'Dimensioning public variable and declare data type
'A Public variable can be accessed from any module, Sub Procedure, Function or Class within a specific workbook.
Public WS As Worksheet
'Name macro and parameters
Sub SearchWKBooksSubFolders(Optional Folderpath As Variant, Optional Str As Variant)
'Dimension variables and declare data types
Dim myfolder As String
Dim a As Single
Dim sht As Worksheet
Dim Lrow As Single
Dim Folders() As String
Dim Folder As Variant
'Redimension array variable
ReDim Folders(0)
'IsMissing returns a Boolean value indicating if an optional Variant parameter has been sent to a procedure.
'Check if FolderPath has not been sent
If IsMissing(Folderpath) Then
'Add a worksheet
Set WS = Sheets.Add
'Ask for a folder to search
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
myfolder = .SelectedItems(1) & "\"
End With
'Ask for a search string
Str = Application.InputBox(prompt:="Search string:", Title:="Search all workbooks in a folder", Type:=2)
'Stop macro if no search string is entered.
If Str = "" Then Exit Sub
'Save "Search string:" to cell "A1"
WS.Range("A1") = "Search string:"
'Save variable Str to cell "B1"
WS.Range("B1") = Str
'Save "Path:" to cell "A2"
WS.Range("A2") = "Path:"
'Save variable myfolder to cell "B2"
WS.Range("B2") = myfolder
'Save "Folderpath" to cell "A3"
WS.Range("A3") = "Folderpath"
'Save "Workbook" to cell "B3"
WS.Range("B3") = "Workbook"
'Save "Worksheet" to cell "C3"
WS.Range("C3") = "Worksheet"
'Save "Cell Address" to cell "D3"
WS.Range("D3") = "Cell Address"
'Save "Link" to cell "E3"
WS.Range("E3") = "Link"
'Save variable myfolder to variable Folderpath
Folderpath = myfolder
'Dir returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
Value = Dir(myfolder, &H1F)
'Continue here if FolderPath has been sent
Else
'Check if two last characters in Folderpath is "//"
If Right(Folderpath, 2) = "\\" Then
'Stop macro
Exit Sub
End If
'Dir returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.
Value = Dir(Folderpath, &H1F)
End If
'Keep iterating until Value is nothing
Do Until Value = ""
'Check if Value is . or ..
If Value = "." Or Value = ".." Then
'Continue here if Value is not . or ..
Else
'Check if Folderpath & Value is a folder
If GetAttr(Folderpath & Value) = 16 Then
'Add folder name to array variable Folders
Folders(UBound(Folders)) = Value
'Add another container to array variable Folders
ReDim Preserve Folders(UBound(Folders) + 1)
'Continue here if Value is not a folder
'Check if file ends with xls, xlsx, or xlsm
ElseIf Right(Value, 3) = "xls" Or Right(Value, 4) = "xlsx" Or Right(Value, 4) = "xlsm" Then
'Enable error handling
On Error Resume Next
'Check if workbook is password protected
Workbooks.Open Filename:=Folderpath & Value, Password:="zzzzzzzzzzzz"
'Check if an error has occurred
If Err.Number <> 0 Then
'Write the workbook name and the phrase "Password protected"
WS.Range("A4").Offset(a, 0).Value = Value
WS.Range("B4").Offset(a, 0).Value = "Password protected"
'Add 1 to variable 1
a = a + 1
'Disable error handling
On Error GoTo 0
'Continue here if an error has not occurred
Else
'Iterate through all worksheets in active workbook
For Each sht In ActiveWorkbook.Worksheets
'Expand all groups in sheet
sht.Outline.ShowLevels RowLevels:=8, ColumnLevels:=8
'Search for cells containing search string and save to variable c
Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
'Check if variable c is not empty
If Not c Is Nothing Then
'Save cell address to variable firstAddress
firstAddress = c.Address
'Do ... Loop While c is not nothing
Do
'Save row of last non empty cell in column A
Lrow = WS.Range("A" & Rows.Count).End(xlUp).Row
'Save folderpath to the first empty cell in column A in worksheet WS
WS.Range("A1").Offset(Lrow, 0).Value = Folderpath
'Save value to the first empty cell in column B in worksheet WS
WS.Range("B1").Offset(Lrow, 0).Value = Value
'Save worksheet name to the first empty cell in column C in worksheet WS
WS.Range("C1").Offset(Lrow, 0).Value = sht.Name
'Save cell address to the first empty cell in column D in worksheet WS
WS.Range("D1").Offset(Lrow, 0).Value = c.Address
'Insert hyperlink
WS.Hyperlinks.Add Anchor:=WS.Range("E1").Offset(Lrow, 0), Address:=Folderpath & Value, SubAddress:= _
"'" & sht.Name & "'" & "!" & c.Address, TextToDisplay:="Link"
'Find next cewll containing search string and save to variable c
Set c = sht.Cells.FindNext(c)
'Continue iterate while c is not empty and cell address is not equal to first cell address
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
'Continue with next worksheet
Next sht
End If
'Close workbook
Workbooks(Value).Close False
'Disable error handling
On Error GoTo 0
End If
End If
Value = Dir
Loop
'Go through alll folder names and
For Each Folder In Folders
'start another instance of macro SearchWKBooksSubFolders (recursive)
SearchWKBooksSubFolders (Folderpath & Folder & "\")
Next Folder
'Resize column widths
Cells.EntireColumn.AutoFit
End Sub
I have tested it and the VBA code provided works fine, but I would like to modify it to:
1. Only search in columns A to L and not the entire Sheet
2. Find all values > 1560 instead of the entered string
Would it be quicker to just modify this code?
Regards
useful 
Reply With Quote
Originally Posted by jolivanes
