VBA macro to search contents of a folder of Excel Workbooks

[useful]

I am running Excel 2019 on a Windows 10 Pro 64-bit PC.

A folder on this PC contains many Excel Workbooks and I would be grateful for a VBA macro (as I can't write one) that reads through these Workbooks and finds all Workbooks that contain a value that is greater than 1560 (once I have this macro, I'm certain that I will be able to substitute other values into this field).

I would also be grateful for instructions on how to run this macro to search all of the Workbooks in this folder.

Thank you in anticipation.

Regards
useful

[jolivanes]

In which sheet would that 1560 be?


Adapted from here. Searches all sheets.
http://stackoverflow.com/questions/9558767/loop-through-all-worksheets-in-all-excel-workbooks-in-a-folder-to-change-the-fon


Change the references to B6 as required. B6 has the search value.



Sub CheckFiles()
Const fPath As String = "C:\Folder Name\Sub Folder Name\"
Dim sh As Worksheet
Dim sName As String
Dim fnd As Range
Dim sw As String
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
If [B6] = "" Then MsgBox "Enter a word to search for in cell B6 first!": Exit Sub '<---- Change required?
sName = Dir(fPath & "*.xls*")
sw = ActiveSheet.Range("B6").Value '<---- Change required?
Do Until sName = ""
With GetObject(fPath & sName)
For Each sh In .Worksheets
With sh
Set fnd = sh.Cells.Find(what:=sw, Lookat:=xlPart, MatchCase:=False)
If Not fnd Is Nothing Then Cells(Rows.Count, 2).End(xlUp).Offset(1) = "Found in " & sName & _
" in cell " & fnd.Address & " in sheet " & sh.Name '<----- Change the 2 to the Column number where you want the result
End With
Next sh
.Close True
End With
sName = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

[useful]

Firstly, thank you for the quick response.

My apologies, in my haste, I forgot to add two important pieces of information:

1. Each Workbook in the folder only contains one spreadsheet
2. The only range in each spreadsheet that I would like to search is A1:K127

In other words, what I would like to find is any Workbook in the folder where its spreadsheet contains a number greater than 1560 in the range A1:K127

I hope this makes it clearer.

Also, I would be grateful for instructions on how to run this VBA code.

Thanks again.
useful

[jolivanes]

Sub CheckFiles_B()
Const fPath As String = "C:\Folder Name\Sub Folder Name\" '<---- Change required
Dim sName As String
Dim c As Range
Dim sw As Long
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
If [B6] = "" Then MsgBox "Enter a value to search for in cell B6 first!": Exit Sub '<---- Change required?
sName = Dir(fPath & "*.xls*")
sw = ActiveSheet.Range("B6").Value '<---- Change required?
Do Until sName = ""
With GetObject(fPath & sName)
With .Sheets(1)
For Each c In .Range("A1:K127")
If c.Value > sw Then Cells(Rows.Count, 2).End(xlUp).Offset(1) = "Found in " & sName & _
" in cell " & c.Address(0, 0) & " in sheet " & Sheets(1).Name '<----- Change the 2 to the Column number where you want the result
Next c
End With
.Close True
End With
sName = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub


29236

29237

[useful]

Thank you very much for the VBA code and the instructions!

As I am not a programmer, I am having some difficulties with the substitutions. Whatever I try fails.

I changed the path, which was easy, but I am having a lot of trouble with the concept of B6.

There is nothing that I want in cell B6. What I want to do is to search the range A1:K127 in each spreadsheet (there is only one in each Workbook) for a value that is greater than 1560.

I have no idea how to make this change in the code.

Your assistance would be much appreciated.

Regards
useful :(

[jolivanes]

OK, now we know what you don't want but where do you want the result(s)?

Result will be in the 2nd Column ( = 2) in the sheet you have open when running the macro. (Column A = 1, Column B = 2, Column C = 3 etc)

Sub CheckFiles_C()
Const fPath As String = "C:\Folder Name\Sub Folder Name\" '<---- Change required
Dim sName As String
Dim c As Range
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
sName = Dir(fPath & "*.xls*")
Do Until sName = ""
With GetObject(fPath & sName)
With .Sheets(1)
For Each c In .Range("A1:K127")
If c.Value > 1560 Then Cells(Rows.Count, 2).End(xlUp).Offset(1) = "Found in " & sName & _
" in cell " & c.Address(0, 0) & " in sheet " & Sheets(1).Name '<----- Change the 2 to the Column number where you want the result
Next c
End With
.Close True
End With
sName = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

[useful]

Thank you for your prompt response again. I really appreciate the help.

The place where the results are displayed is just fine, unfortunately, however, the results are not correct.

The VBA code only lists some of the Workbooks that are in that folder and only lists the cells in those Workbooks that contain the headings, not cells that contain values.

Regards
useful :(

[useful]

I was doing some more research on this issue and found this:

https://www.get-digital-help.com/search-all-workbooks-in-a-folder-and-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) &amp; "\"
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 &amp; 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 :bow:

[jolivanes]

Re: "The VBA code only lists some of the Workbooks that are in that folder"
That would indicate that the so called missing workbooks don't have a value of >1560 in the Range A1:k127.

Re: "only lists the cells in those Workbooks that contain the headings, not cells that contain values."
Unfortunately, I do not know what you mean by that.

Maybe attach a workbook that has the values but not show it after running the macro.
Indicate in the workbook which cells you think should be shown after the macro is finished.

[useful]

Thank you for your prompt response.

Given that the VBA code that I found and sent you (above) does work correctly, albeit it searches the whole Sheet instead of only columns A to L (or cells A1:L127 if specifying columns is not possible in VBA code) and looks for an entered string instead of a value > 1560, would it not be quicker to modify this code, rather than spend time investigating the reason why the other VBA code fails?

Regards
useful

[snb]

So what is the purpose of this at first glance seemingly pointless excercition ?
Why so many VBA lines for such a simple task ?

Analysing code is more fruitful than 'finding' another.

[Aussiebear]

@snb, From my reading the OP wanted a simple concept of code, but what he has found is in your words "so many lines for such a simple task". Rather than question the reason why someone wants to complete a task, why not compile something to assist the OP?

[snb]

Because very often the found 'solution' doesn't fit the TS's final purpose.
The exact, meticulaous formulation of a purpose is 95 % of the solution most of the time.

[georgiboy]

Hi useful,

I tested jolivanes code and got the headers in my search results also however' by adding an 'And' statement in the mix making sure it is only looking at numerical values I got the results I believe you are after. See below.


Sub CheckFiles_C()
Const fPath As String = "C:\Users\MrDummy\Desktop\test\" '<---- Change required
Dim sName As String
Dim c As Range
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
sName = Dir(fPath & "*.xls*")
Do Until sName = ""
With GetObject(fPath & sName)
With .Sheets(1)
For Each c In .Range("A1:K127")
If c.Value > 1560 And IsNumeric(c.Value) Then Cells(Rows.Count, 2).End(xlUp).Offset(1) = "Found in " & sName & _
" in cell " & c.Address(0, 0) & " in sheet " & Sheets(1).Name '<----- Change the 2 to the Column number where you want the result
Next c
End With
.Close True
End With
sName = Dir
Loop
With Application
.Calculation = xlAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub

Hope this helps

[useful]

My grateful thanks georgiboy!

The code now works fine!

Regards
useful :clap:

[jolivanes]

@ Aussiebear
I think if the OP had responded to the requests in Post #9 all this would have been solved right away.

[Aussiebear]

@ Aussiebear
I think if the OP had responded to the requests in Post #9 all this would have been solved right away.

Clearer than the following from Post #3 ?

My apologies, in my haste, I forgot to add two important pieces of information:

1. Each Workbook in the folder only contains one spreadsheet
2. The only range in each spreadsheet that I would like to search is A1:K127

In other words, what I would like to find is any Workbook in the folder where its spreadsheet contains a number greater than 1560 in the range A1:K127

[jolivanes]

I don't see what one has to do with the other but hey, a Merry Christmas and a Healthy, Happy and Prosperous New Year