Macro - Search spreadsheets for values greater than and returning list

[xlstudent]

I am looking for a way to search the entire worksheet of multiple spreadsheets within a single folder for values greater than 100. If cells values of greater than 100 are found, then these will be listed in a worksheet/tab with file directory, worksheet name, cell address, cell value, and hyperlink to that cell.



My VBA skills are basic and therefore not sure where to start. Any hints/tips would be great or code would be great.

Thanks for your help!

[WizzardOfOz]

Option Explicit


Sub LazyStudent()
Dim sFolder As String, sFile As String, sLazy As String
Dim oSheet, oCell
Dim i As Long

'get the path
sFolder = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
sFolder = Replace(sFolder, Dir(sFolder), "")

Workbooks.Add
sLazy = ActiveWorkbook.Name
With Workbooks(sLazy).Sheets(1)
.Cells(1, 1) = "folder"
.Cells(1, 2) = "file"
.Cells(1, 3) = "Sheet"
.Cells(1, 4) = "Address"
.Cells(1, 5) = "Value"
End With


i = 2
sFile = Dir(sFolder & "*.xl*")
While sFile <> ""

Workbooks.Open sFolder & sFile
For Each oSheet In Workbooks(sFile).Sheets
If oSheet.Type = xlWorksheet Then
For Each oCell In oSheet.UsedRange
Application.StatusBar = oSheet.Name & " " & oCell.Address: DoEvents
If IsNumeric(oCell.Value2) And oCell.Value2 > 100 Then
With Workbooks(sLazy).Sheets(1)
.Cells(i, 1) = sFolder 'folder
.Cells(i, 2) = sFile 'file
.Cells(i, 3) = oSheet.Name 'file
.Cells(i, 4) = oCell.Address
.Cells(i, 5) = oCell.Value2
i = i + 1
End With
End If
Next
End If
Next
ActiveWorkbook.Close False
Application.StatusBar = " "

sFile = Dir
Wend

End Sub

[WizzardOfOz]

I let you workout how to do the hyperlink. Tip google "VBA add hyperlink"

[xlstudent]

Thanks Wizzard of oz - that's super. Is there any way to search a whole directory, rather than just a single file?

[WizzardOfOz]

Yes simple, use the File System Object and a recursive loop. Below is code that I found googling the search terms (VBA FSO recursive folder). I'll leave it up to you to combine yesterdays and today's code.

Sub Main
Dim FileSystem As Object
Dim HostFolder As String
HostFolder = "C:\"
Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)
End Sub

Sub DoFolder(Folder)    
Dim SubFolder    
For Each SubFolder In Folder.SubFolders        
DoFolder SubFolder    
Next    

Dim File    
For Each File In Folder.Files        
' Operate on each file    
Next
End Sub

[xlstudent]

That's super - thanks a lot

[snb]

To retrieve all filenames in folder "G:\" and it's subfolders and store them in array 'sn'

Sub M_snb()
   c00="G:\"
   sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "*.*"" /b/s/a").stdout.readall,vbcrlf)
End Sub