"Batch" Search within Excel Files on Network 1

[LevelThought]

Task: Have a list of 900 unique account numbers that should appear in one of the 200 Microsoft Excel workbooks that are located on several network drives. Initially, I sorted the 900 account numbers and was opening up each workbook and searching for the account number! However, this is not feasible! Therefore, I downloaded a full-text search utility that scans within files on my local or network drive and looks for a given keyword, a number of keywords, or a phrase. This appears to work if I type in 1 account number at a time.

Question: Is anyone aware of a method or software that will allow me to enter a block of account numbers (For example, all 900 account numbers) via an Excel worksheet and then have the search utility to list the Excel workbook for each of the 900 account numbers in another column, etc.? In other words, I would like to enter the 900 account numbers all at once instead of one-at-a-time. (Also, the account number might appear in more than one Excel file.)



Thanks in advance.

 

[firefytr]

What are the paths of the different locations? Do you have a table of locations to look in and the account numbers to look for?

Also, do you know what sheet(s) to look on? All of them? Certain ones? Do you only want a list of workbooks, their names and paths, of those account numbers found? How about a new worksheet for each unique account number listing such data?

-----------
Regards,
Zack Barresse

 

[LevelThought]

What I have done over the last hour is move all of the 200 Excel workbooks to the same place on the network drive:

T:\Reports\*.xls

Some of the 200 Excel workbooks might contain 2 or more worksheets. Therefore, I need to search through each workbook and each worksheet within the workbook.

All of the 900 unique numbers are on one worksheet within an Excel workbook titled "AccountNo.xls."

I would like to generate another worksheet that has the following columns: AccountNo, NameOfWorkbook, PathOfWorkbook, and DateOfWorkbook.

Is this possible?

If so, I would appreciate any assistance to create this.

 

[firefytr]

Yes, it's possible. I recommend another column for sheet name as well if more than one sheets are possible. Also, what is DateOfWorkbook? And is that drive mapped?

-----------
Regards,
Zack Barresse

 

[LevelThought]

Having another column for sheet name would be appreciated.

Oops!, the "DateOfWorkbook" is just the "DateModified" that indicates the date that the Excel Workbook was last modified. This value is not absolutely necessary but would be helpful if it could be obtained. I guess that the most important piece is the path, filename, and sheet name of the Excel Workbook that each of the 900 accounts are located.

 

[firefytr]

Okay, so the account numbers to look for, are they located in the "AccountNo.xls" file? And which sheet? The first sheet? Sheet1? Another name? Are all the numbers in this column unique?

-----------
Regards,
Zack Barresse

 

[LevelThought]

Yes, the account numbers to look for are in the Excel workbook titled "AccountNo.xls" and the specific sheet name is titled "Sheet1."

All of the numbers are unique and are located in the 3rd column of Sheet1.

 

[firefytr]

Okay, so AccountNo is col C, PathOfWorkbook is col D, Name of Workbook is col E, etc.. Also, what if no value is found, leave that rows data blank or put "Not Found"?

-----------
Regards,
Zack Barresse

 

[LevelThought]

Yes,

AccountNo is in column C and the following columns should be populated:

column D = PathOfWorkbook
column E = NameOfWorkbook
column F = SheetName (Where AccountNo was found)

and column D would contain "NotFound" if the AccountNo was not found within the 200 Excel workbooks that are located at T:\Reports\

 

[firefytr]

Lightly tested, test this with test data only first...

Sub SearchAllFiles()
    Dim wb As Workbook, wbAcct As Workbook
    Dim ws As Worksheet, wsAcct As Worksheet
    Dim arrLoop() As Variant, arrWb() As String
    Dim i As Long, n As Long, rngFind As Range
    Dim strPath As String, strOrig As String, strDr As String, strODr As String
    Dim strFoundName As String, strFoundPath As String, dtLM As Date
    Dim blnFound As Boolean, blnOpen As Boolean
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set wbAcct = ThisWorkbook
    Set wsAcct = wbAcct.Sheets("Sheet1")
    strPath = "C:\Reports\"
    strDr = Left(strPath, 3)
    strOrig = CurDir
    strODr = Left(strOrig, 3)
    ChDrive strDr
    ChDir strPath
    x = 2 'row start
    arrLoop = wsAcct.Range("C2", wsAcct.Cells(wsAcct.Rows.Count, 3).End(xlUp)).Value
    For i = LBound(arrLoop) To UBound(arrLoop)
        If IsEmpty(arrLoop(i, 1)) Then GoTo SkipArr
        With Application.FileSearch
            .NewSearch
            .LookIn = strPath
            .FileType = msoFileTypeExcelWorkbooks
            .Execute
            If .FoundFiles.Count = 0 Then GoTo SkipArr
            For n = 1 To .FoundFiles.Count
                strFoundPath = Left(.FoundFiles(n), InStrRev(.FoundFiles(n), "\"))
                strFoundName = Right(.FoundFiles(n), Len(.FoundFiles(n)) - Len(strFoundPath))
                If WbIsOpen(strFoundName) Then
                    Set wb = Workbooks(strFoundName)
                    blnOpen = True
                Else
                    Set wb = Workbooks.Open(strFoundPath & strFoundName)
                    blnOpen = False
                    ReDim Preserve arrWb(1 To i * n)
                    arrWb(i * n) = wb.Name
                End If
                dtLM = wb.BuiltinDocumentProperties("last save time")
                blnFound = False
                For Each ws In wb.Worksheets
                    Set rngFind = ws.Cells.Find(arrLoop(i, 1))
                    If Not rngFind Is Nothing Then
                        blnFound = True
                        wsAcct.Cells(i + 1, "D").Value = wb.Path
                        wsAcct.Cells(i + 1, "E").Value = wb.Name
                        wsAcct.Cells(i + 1, "F").Value = ws.Name
                        wsAcct.Cells(i + 1, "G").Value = CDate(Format(dtLM, "dd-mm-yyyy"))
                    End If
                Next ws
                If blnFound = False Then wsAcct.Cells(i + 1, "D").Value = "Not Found"
            Next n
        End With
SkipArr:
    Next i
    For i = LBound(arrWb) To UBound(arrWb)
        If arrWb(i) <> "" Then Workbooks(arrWb(i)).Close False
    Next i
    ChDrive strODr
    ChDir strOrig
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Set wb = Nothing
    Set ws = Nothing
    Set wbAcct = Nothing
    Set wsAcct = Nothing
End Sub

Function WbIsOpen(wbName As String) As Boolean
    On Error Resume Next
    WbIsOpen = Len(Workbooks(wbName).Name)
End Function

-----------
Regards,
Zack Barresse

 

[firefytr]

Oh, make sure you change this line...

strPath = "C:\Reports\"

..to..

strPath = "T:\Reports\"

I had it that way for testing, apologies.

-----------
Regards,
Zack Barresse

 

[LevelThought]

Tried the code and the following issues/challenges arise:

It appears that the code only populated the first row, it did not go down the list of 900 accounts

All of the 200 Excel workbooks were opened, and not closed

As a result of the 200 Excel workbooks being opened, I encountered memory issues



Will try it again and see what happens.

 

[firefytr]

We can close each workook when done with it, which may work better. I only tested with a few files, which is probably why it worked alright on my machine. It's designed to close them after, probably a weak foresight on my part. I'll redo some code and get back shortly.

-----------
Regards,
Zack Barresse

 

[LevelThought]

firefytr,

Additional issues;

It appears that the second iteration of running the code resulted in Microsoft Excel being in a locked state.

Then, I tried to use "CTRL-ALT-DELETE" and could not.

Therefore, I had to shutdown the computer. Upon shutting down the computer, a dialog box appeared and stated the following:

"Do you want to save the changes? (Microsoft Excel recalculates formulas when opening files last saved by an earlier version of Excel)"

It appears that this dialog box will appear for each Microsoft Excel file that was last saved by an earlier version of Excel!

Currently, using Microsoft Excel 2003 on a Windows XP Professional operating system.

Thanks greatly for the insight.

 

[firefytr]

A few minor changes to the code. Should run on your machine, although this may take a while. It will give you a percentage complete in the status bar as well (bottom right corner of Excel's application window).

Sub SearchAllFiles()
    Dim wb As Workbook, wbAcct As Workbook
    Dim ws As Worksheet, wsAcct As Worksheet
    Dim arrLoop() As Variant
    Dim i As Long, n As Long, rngFind As Range
    Dim strPath As String, strOrig As String, strDr As String, strODr As String
    Dim strFoundName As String, strFoundPath As String, dtLM As Date
    Dim blnFound As Boolean, blnOpen As Boolean
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set wbAcct = ThisWorkbook
    Set wsAcct = wbAcct.Sheets("Sheet1")
    strPath = "C:\Reports\"
    strDr = Left(strPath, 3)
    strOrig = CurDir
    strODr = Left(strOrig, 3)
    ChDrive strDr
    ChDir strPath
    arrLoop = wsAcct.Range("C2", wsAcct.Cells(wsAcct.Rows.Count, 3).End(xlUp)).Value
    For i = LBound(arrLoop) To UBound(arrLoop)
        If IsEmpty(arrLoop(i, 1)) Then GoTo SkipArr
        With Application.FileSearch
            .NewSearch
            .LookIn = strPath
            .FileType = msoFileTypeExcelWorkbooks
            .Execute
            If .FoundFiles.Count = 0 Then GoTo SkipArr
            For n = 1 To .FoundFiles.Count
                Application.StatusBar = Format(i / UBound(arrLoop), "Percent") & " percent complete..."
                strFoundPath = Left(.FoundFiles(n), InStrRev(.FoundFiles(n), "\"))
                strFoundName = Right(.FoundFiles(n), Len(.FoundFiles(n)) - Len(strFoundPath))
                If WbIsOpen(strFoundName) Then
                    Set wb = Workbooks(strFoundName)
                    blnOpen = True
                Else
                    Set wb = Workbooks.Open(strFoundPath & strFoundName)
                    blnOpen = False
                End If
                dtLM = wb.BuiltinDocumentProperties("last save time")
                blnFound = False
                For Each ws In wb.Worksheets
                    Set rngFind = ws.Cells.Find(arrLoop(i, 1))
                    If Not rngFind Is Nothing Then
                        blnFound = True
                        wsAcct.Cells(i + 1, "D").Value = wb.Path
                        wsAcct.Cells(i + 1, "E").Value = wb.Name
                        wsAcct.Cells(i + 1, "F").Value = ws.Name
                        wsAcct.Cells(i + 1, "G").Value = CDate(Format(dtLM, "dd-mm-yyyy"))
                    End If
                Next ws
                If blnFound = False Then wsAcct.Cells(i + 1, "D").Value = "Not Found"
                If blnOpen = False Then wb.Close False
            Next n
        End With
SkipArr:
    Next i
    Application.StatusBar = "Complete!"
    ChDrive strODr
    ChDir strOrig
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Set wb = Nothing
    Set ws = Nothing
    Set wbAcct = Nothing
    Set wsAcct = Nothing
End Sub

Function WbIsOpen(wbName As String) As Boolean
    On Error Resume Next
    WbIsOpen = Len(Workbooks(wbName).Name)
End Function

Now onto your current issues. Were you able to get the application up and running again after a restart? You may have to run a Detect & Repair from the Help menu.

-----------
Regards,
Zack Barresse

 

[LevelThought]

firefytr,

Upon trying the 3rd iteration, A system error was generated and the code stopped running. I think what might have occurred is that one of the files within "C:\Reports" was not a standard file containing the accounts but an analysis performed by someone.

The following questions arise:

Is there a method to search for the account number within all Excel workbooks in a particular directory without opening the workbook?

Are you aware of a search utility download that will perform the search without opening the workbooks?

Columns D thru G along Row 2 are populated with the following, respectively;Not Found, Review Rpt, AccountInDefault, 6/14/2005. If the account number is not found, I would assume that column D would be the only column populated along Row 2. Then, shouldn't the code skip to the next line, Row 3 and evaluate what is in Column C and populate Columns D through G.

Maybe, "Found" should be populated if the account number was located within the 200 workbooks and "NotFound" if the account number is not located.

What if the number of workbooks increase exponentially? For example, 1000 workbooks. Then, wouldn't memory issues become a problem?

I am continuing to test and sincerely appreciate your insight and time.

Overall, a rather remarkable piece of code!

 

[firefytr]

You may have to break the workbooks up into smaller groups and change the folder in the code as you may be hitting a memory issue.

As for a utility, I'm not really sure of one. Of course you could do this up in regular ole VB and it would probably be slightly faster than running everything from within an Excel instance using VBA.

I'm not sure of anyway to check cell values without opening the workbook. Sorry.

-----------
Regards,
Zack Barresse

 

[LevelThought]

The code works perfectly on 15 to 25 accounts while searching within 10 to 20 Excel workbooks.

Would it be relatively easy to modify the code to allow for the following:

Only search the first 4 column of the 200 Excel files.
(Is the code searching every column on the Exel files?)


Include another column (column H) that identifies the specific cell where the account number is located within one or more Excel file.

and automatically create hyperlinks where the Manager can click on the links and go to the specific cell within the Excel file.

I have tried to modify the code to automatically generate the hyperlinks but have not been successful. (So far, I have something manual like this - (in Column I = Hyperlink("File.xls) Sheet2!B5","Click on This")

Thanks in advance for any additional insight.

 

[firefytr]

Yes, that is rather easily done, but were coming up against a memory issue, which is not fixed by limiting the search to only four columns. The bottom line is you need to break up your search to smaller chunks (of files) at a time.

I'll throw the other stuff together in the next day or so (a little busy right now). Take care.

-----------
Regards,
Zack Barresse

 

[LevelThought]

firefytr,

Any additional insight regarding the automation of hyperlinks?

Thanks in advance.