Macro - Search spreadsheets for values greater than and returning list

X

xlstudent

New member
Joined
Sep 2, 2014
Messages
3
Reaction score
0
Points
0
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!
 
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
 
I let you workout how to do the hyperlink. Tip google "VBA add hyperlink"
 
Thanks Wizzard of oz - that's super. Is there any way to search a whole directory, rather than just a single file?
 
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.

Code: 
Sub Main
[COLOR=#00008B]Dim[/COLOR] FileSystem [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]Object
[/COLOR][COLOR=#00008B]Dim[/COLOR] HostFolder [COLOR=#00008B]As[/COLOR] [COLOR=#00008B]String
[/COLOR]HostFolder = [COLOR=#800000]"C:\"
[/COLOR][COLOR=#00008B]Set[/COLOR] FileSystem = CreateObject([COLOR=#800000]"Scripting.FileSystemObject"[/COLOR])
DoFolder FileSystem.GetFolder(HostFolder)
End Sub

[COLOR=#00008B]Sub[/COLOR] DoFolder(Folder)    
[COLOR=#00008B]Dim[/COLOR] SubFolder    
[COLOR=#00008B]For[/COLOR] [COLOR=#00008B]Each[/COLOR] SubFolder [COLOR=#00008B]In[/COLOR] Folder.SubFolders        
DoFolder SubFolder    
[COLOR=#00008B]Next[/COLOR]    

[COLOR=#00008B]Dim[/COLOR] File    
[COLOR=#00008B]For[/COLOR] [COLOR=#00008B]Each[/COLOR] File [COLOR=#00008B]In[/COLOR] Folder.Files        
[COLOR=#808080]' Operate on each file[/COLOR]    
[COLOR=#00008B]Next
[/COLOR][COLOR=#00008B]End[/COLOR] [COLOR=#00008B]Sub
[/COLOR]
 
Last edited:
To retrieve all filenames in folder "G:\" and it's subfolders and store them in array 'sn'

Code: 
Sub M_snb()
   c00="G:\"
   sn=split(createobject("wscript.shell").exec("cmd /c Dir """ & c00 & "*.*"" /b/s/a").stdout.readall,vbcrlf)
End Sub
 
You must log in or register to reply here.
Back
Top