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 © 2025 vBulletin Solutions Inc. All rights reserved.