PDA

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.