View Full Version : Searching all workbooks in a folder
gibbo1715
12-09-2005, 08:20 AM
All
I need to search through about 500 workbooks to identify if a cell has the value yes in it.
For one cell I ve got that sorted as follows
Option Explicit
Sub Search()
Dim Cell As Range, FirstAddress$, i%, N%
Dim LookingFor$, ThisBook As Workbook
Dim J As Long
Set ThisBook = ThisWorkbook
LookingFor = "Yes"
Application.ScreenUpdating = False
'now open & search all the other books in the folder
With Application.FileSearch
.LookIn = ActiveWorkbook.Path
.FileName = "*.xls" '<< only search workbooks
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) <> ThisWorkbook.FullName Then
Application.Workbooks.Open(.FoundFiles(N)).Activate
'search all the sheets in the current book
With Sheets(1).Range("B12")
Set Cell = .Find(LookingFor, LookIn:=xlValues, searchorder:=xlByRows, _
LookAt:=xlPart, MatchCase:=False)
If Cell Is Nothing Then '<< there's nothing on this sheet
GoTo Finish
Else
If Cell = "Yes" Then
J = J + 1
End If
End If
End With
Finish:
ActiveWorkbook.Close savechanges:=False
End If
'search finished in current book, search the next book
Next N
End If
End With
'go back to "ThisBook"
Sheets(1).Activate
Range("B12") = J
End Sub
My problem is I need to check the range B12:C100 and if a cell contains the word yes I need the same cell on my master sheet to be a count of all the other workbooks that contain a yes in the coresponding cell
So for example B12 could by 50 C12 could be 20 if yes is only ion cell C12 in 20 of the workbooks
Any Ideas Please
Cheers
Gibbo
Bob Phillips
12-09-2005, 08:36 AM
Here's some code Gibbo,
Dim aryFiles
Dim oFSO
Sub LoopFolders()
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
selectFiles "c:\MyTest"
Set oFSO = Nothing
End Sub
'---------------------------------------------------------------------------
Sub selectFiles(sPath)
'---------------------------------------------------------------------------
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Set Folder = oFSO.GetFolder(sPath)
For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr
For Each file In Folder.Files
If file.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=file.Path
For Each cell In oWB.Range("B12:C100")
If LCase(cell.Value) = "yes" Then
oThis.Range(cell.Address).Value = _
oThis.Range(cell.Address).Value + 1
End If
Next cell
oWB.Close savechanges:=False
End If
Next file
End Sub
gibbo1715
12-09-2005, 08:59 AM
Thanks but doesnt recognise
oWB?
Cheers
Gibbo
gibbo1715
12-12-2005, 01:30 AM
I ve ammended by code as follows and seems to work ok for me
Sub Search()
Dim Cell As Range, FirstAddress$, i%, N%
Dim LookingFor$, ThisBook As Workbook
Dim J As Long
Dim StrCol As String
Set ThisBook = ThisWorkbook
LookingFor = "Yes"
Application.ScreenUpdating = False
'now open & search all the other books in the folder
'Start Column
StrCol = "B"
Start:
'rows to search
For i = 12 To 100
With Application.FileSearch
.LookIn = ActiveWorkbook.Path
.FileName = "*.xls" '<< only search workbooks
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) <> ThisWorkbook.FullName Then
Application.Workbooks.Open(.FoundFiles(N)).Activate
'search all the sheets in the current book
With Sheets(1).Range(StrCol & i)
Set Cell = .Find(LookingFor, LookIn:=xlValues, searchorder:=xlByRows, _
LookAt:=xlPart, MatchCase:=False)
If Cell Is Nothing Then '<< there's nothing on this sheet
GoTo Finish
Else
If Cell = "Yes" Then
J = J + 1
End If
End If
End With
Finish:
ActiveWorkbook.Close savechanges:=False
End If
'search finished in current book, search the next book
Next N
End If
End With
'go back to "ThisBook"
Sheets(1).Activate
Range(StrCol & i) = J
J = 0
Next i
If StrCol = "B" Then
'Change column to C if not column c already
StrCol = "C"
GoTo Start
Else
Exit Sub
End If
End Sub
I would still like to get xld's method working though as im not convinced my code is the best way to go ( i dont like this goto method and never have)
Can anyone help me get xld's method working please
it says i need an object for this line
For Each Cell In oWB.Range("B12:C100")
cheers
gibbo
Bob Phillips
12-12-2005, 03:00 AM
Try this mod
Option Explicit
Dim aryFiles
Dim oFSO
Sub LoopFolders()
Dim oThis As ActiveSheet
Dim i As Integer
Set oThis = ActiveSheet
Set oFSO = CreateObject("Scripting.FileSystemObject")
selectFiles "c:\MyTest"
Set oFSO = Nothing
End Sub
'---------------------------------------------------------------------------
Sub selectFiles(sPath, sh As Worksheet)
'---------------------------------------------------------------------------
Dim oWB As Workbook
Dim oThis As Worksheet
Dim cell As Range
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Set Folder = oFSO.GetFolder(sPath)
For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr
For Each file In Folder.Files
If file.Type = "Microsoft Excel Worksheet" Then
Set oWB = Workbooks.Open(Filename:=file.Path)
For Each cell In oWB.Range("B12:C100")
If LCase(cell.Value) = "yes" Then
sh.Range(cell.Address).Value = _
sh.Range(cell.Address).Value + 1
End If
Next cell
oWB.Close savechanges:=False
End If
Next file
End Sub
gibbo1715
12-12-2005, 03:31 AM
Thanks for the reply but
Still Get an error here
Dim oThis As ActiveSheet' (User defined type not defined?)
changed that to worksheet
and now get an error here
selectFiles "C:\Test\" 'Arguement not optional
Cheers
Gibbo
Bob Phillips
12-12-2005, 04:26 AM
Sorry Gibbo,
Trying to do too many things at once, and am not concebtraing.
This versions runs ok, hopefully it does what you want
Option Explicit
Dim aryFiles
Dim oFSO
Sub LoopFolders()
Dim oThis As Worksheet
Dim i As Integer
Set oThis = ActiveSheet
Set oFSO = CreateObject("Scripting.FileSystemObject")
selectFiles "c:\MyTest", oThis
Set oFSO = Nothing
End Sub
'---------------------------------------------------------------------------
Sub selectFiles(sPath, sh As Worksheet)
'---------------------------------------------------------------------------
Dim oWB As Workbook
Dim oThis As Worksheet
Dim cell As Range
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Set Folder = oFSO.GetFolder(sPath)
For Each fldr In Folder.Subfolders
selectFiles fldr.path, sh
Next fldr
For Each file In Folder.Files
If file.Type = "Microsoft Excel Worksheet" Then
Set oWB = Workbooks.Open(Filename:=file.path)
For Each cell In oWB.ActiveSheet.Range("B12:C100")
If LCase(cell.Value) = "yes" Then
sh.Range(cell.Address).Value = _
sh.Range(cell.Address).Value + 1
End If
Next cell
oWB.Close savechanges:=False
End If
Next file
End Sub
gibbo1715
12-12-2005, 06:28 AM
Thanks
That did the job a lot quicker than my method
Knew you d have a better way
Gibbo
malik641
12-12-2005, 06:53 AM
Sorry Gibbo,
Trying to do too many things at once, and am not concebtraing.
This versions runs ok, hopefully it does what you want
Option Explicit
Dim aryFiles
Dim oFSO
Sub LoopFolders()
Dim oThis As Worksheet
Dim i As Integer
Set oThis = ActiveSheet
Set oFSO = CreateObject("Scripting.FileSystemObject")
selectFiles "c:\MyTest", oThis
Set oFSO = Nothing
End Sub
'---------------------------------------------------------------------------
Sub selectFiles(sPath, sh As Worksheet)
'---------------------------------------------------------------------------
Dim oWB As Workbook
Dim oThis As Worksheet
Dim cell As Range
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr
Set Folder = oFSO.GetFolder(sPath)
For Each fldr In Folder.Subfolders
selectFiles fldr.path, sh
Next fldr
For Each file In Folder.Files
If file.Type = "Microsoft Excel Worksheet" Then
Set oWB = Workbooks.Open(Filename:=file.path)
For Each cell In oWB.ActiveSheet.Range("B12:C100")
If LCase(cell.Value) = "yes" Then
sh.Range(cell.Address).Value = _
sh.Range(cell.Address).Value + 1
End If
Next cell
oWB.Close savechanges:=False
End If
Next file
End Sub
Hey Bob, I don't really understand this code (how it works, I mean).
The piece I get confused with is this part:
For Each fldr In Folder.Subfolders
selectFiles fldr.path, sh
Next fldr
It just seems like it keeps repeating the procedure and sets Folder to something different every time and it looks like it would never stop (even though I know it does).
Could you step me through that?
Thanks in advance :)
Bob Phillips
12-12-2005, 11:25 AM
Hey Bob, I don't really understand this code (how it works, I mean).
The piece I get confused with is this part:
For Each fldr In Folder.Subfolders
selectFiles fldr.path, sh
Next fldr
It just seems like it keeps repeating the procedure and sets Folder to something different every time and it looks like it would never stop (even though I know it does).
Could you step me through that?
Thanks in advance :)
Joseph,
This is an example of recursive code, code that calls itself.
What is happening is that the procedure first gets called with the top level directory. It then loops though all sub-directories, and calls itself with that sub-directory as its path. Thsi goes on until it comes to the bottom level, processes the files in there, and then it works it's way back up, processing the fiels as it goes.
So if you had a directory structure of say
Development
--Access
--Excel
----Worksheets
----VBA
--Powerpoint
----View
------Documents
------Viewer
----VBA
--Word
----Docs
----VBA
it would process the files in the directories in this order
--Access
--Excel ----Worksheets
--Excel ----VBA
--Powerpoint ----View ------Documents
--Powerpoint ----View ------Viewer
--Powerpoint ----VBA
--Word ----Docs
--Word ----VBA
Development
Very powerful, you just need to be careful to make sure you have a proper exit, else you go on for ever.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.