Search folder for worksheet containing string

[Leif]

I could do with some help in automating looking up file numbers which is somewhat time consuming if I use the windows search function. This is something I could possibly run overnight and so speed is not necessarily of the essence.

I have a large number of drawing numbers that I want to cross reference to any workbooks in a folder that contain the drawing number.

The folder contains around 3,000 files, some of which will be backups, and I only want to check those that are a 6-digit number beginning with '6' and with an .xls extension

The workbook may contain multiple worksheets, but I only want to check the active worksheet (i.e. the worksheet that is active when the workbook is opened.)

Once the '6nnnnn' files have been identified/listed, I then need to find the workbooks in another folder that include that number (without the extension). The second search will apply only to files with a 6-digit number beginning with '1' and an .xls extension.

Example:
Drawing number: 502862
First file search path: "P:\600\"
Files in P:\600\ found containing "520862": 600883.xls; 601108.xls
Second file search path: "P:\100\"
Files in P:\100\ found containing "600883" or "601108": 101324.xls; 102769.xls

It is most likely that the searches in each case will only result in one or two files, but potentially could be more. However, I would accept a maximum of five results being returned. (These are 'rare' drawings and so by definition should not be frequently listed!)

Nominally I intend to start off with a worksheet listing the files/results as follows:
Column A: '5nnnnn' drawing number to be searched for (manually entered, up to 100)
Columns B-F: up to five '6nnnnn' file names (without extension) containing the number in Col A
Columns G-K: up to five '1nnnnn' file names (without extension) containing the number(s) in Cols B-F

	A	B	C	D	E	F	G	H	I	J	K
1	5nnnnn	6_1	6_2	6_3	6_4	6_5	1_1	1_2	1_3	1_4	1_5
2	502862	600883	601108				101324	102769
3	502317
4	502107
5
6

(The results can be in any order i.e. they do not need to be sorted ascending.)

Any assistance on this would save me untold hours and be greatly appreciated!!

[Rudi]

Hi Leif,

Some questions for clarity:
1. Does the table in your post represent the end result that the macro must generate? If so, I assume column A will be pre-populated with numbers?
2. Given the number 502862, must the macro open each file starting with 6* and scan the active sheet for any cell entry with the value 502862? If found record the 6* file number?
3. Do you want two macros (one for the 6* numbers) and one for (1* numbers) so you can run them separately, or a single macro to produce the result in one run?

[Leif]

Hi Rudi, and thanks for the quick response!

1. Yes - though anything readable will do! Column A will be pre-populated with 5* numbers (manually entered from hard copies I have in my hand)
2. Yes.
3. Probably a single macro, but if in two distinct sections, I can/could probably modify it for future use.

I envisage the sequence to be something like:

Code: Select all

Part 1:
Read number number in Col A
Search through all 6*.xls files in P:\600\ and record the filename of up to five workbooks containing the 5* number
Part 2:
Read all numbers in Col B-F
Search through all 1*.xls files in P:\100\ and record the filename of up to five workbooks containing the 6* number

Increment Row and read next number in Col A: Do Part 1 : Do part 2

Either resolving in turn each 5* to 6* before resolving each 6* to 1*, or each 5* to 6* and immediately any 6* to 1* makes no difference. In most cases, I expect each 5* to only result in one 6*, and in turn each 6* to only result in one 1*

Thanks!

[Rudi]

TX, that's clear.
I will start looking into this this afternoon/evening when I have some time on my hands.

[Leif]

Thanks again - nooooo panic

[Rudi]

Hi Leif,

Before I continue with the macro to process the 1* files, please check if this macro (to process the 6* files) is working as you need...

Change the path and extension in the macro as needed
The macro should end up listing (up to 5) files starting with 6* for each number in the A column.

Edit as required.
If the code is good and producing expected results, I will use it as the base to create the second macro to process the 1* files for each 6* found.

Leif Master.xlsm

[Leif]

Thanks Rudi - it'll be tomorrow at the earliest before I can test it.
(The family expect me to some time away from work )

[Rudi]

Hi Leif,

Here is the FULL code (which includes processing the 1* files too)

You can replace the code in the sample workbook with the code below (if you want to use the workbook as the template), else just stick the code below into a standard module in your own workbook and run. It seems to run fine on a small set of sample files I set up, but note, I have not included any error handling... please scrutinize the results to ensure it is producing accurate results.

Code: Select all

Sub ListFiles()
Dim sh As Worksheet
Dim rgC5 As Range, rgN As Range, rgF As Range
Dim rgC6 As Range, rgG As Range
Dim sFile1 As String, sFile2 As String
Dim i As Integer, j As Integer
'=======================================================
    '>>> Modify path and file extensions below <<<
    Const sPath1 = "P:\600\"
    Const sPath2 = "P:\100\"
    Const sExt = "*.xls" 'or *.xls* for all Excel files
'=======================================================
    Set sh = ThisWorkbook.Sheets(1)
    Set rgN = sh.Range(sh.Cells(2, 1), sh.Cells(sh.Rows.Count, 1).End(xlUp))
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Clear file names before processing
    Application.Intersect(sh.Range("A1").CurrentRegion, sh.Range("A1").CurrentRegion.Offset(1, 1)).ClearContents
    
    'Get all 6* files for numbers down A column
    For Each rgC5 In rgN.Cells
        sFile1 = Dir(sPath1 & sExt)
        i = 0
        Do While sFile1 <> ""
            If sFile1 <> ThisWorkbook.Name Then
                If Left(sFile1, 1) = "6" Then
                    If i > 5 Then Exit Do
                    Workbooks.Open Filename:=sPath1 & sFile1
                    Set rgF = ActiveSheet.Cells.Find(What:=rgC5.Value)
                    If Not rgF Is Nothing Then
                        i = i + 1
                        rgC5.Offset(0, i).Value = Split(sFile1, ".")(0)
                    End If
                    Workbooks(sFile1).Close False
                End If
            End If
            sFile1 = Dir
        Loop
        
        'Get all 1* files based on 6* files for numbers down A column
        For Each rgC6 In Range(rgC5.Offset(0, 1), rgC5.Offset(0, 5)).Cells
            If rgC6 <> "" Then
                sFile2 = Dir(sPath2 & sExt)
                j = 0
                Do While sFile2 <> ""
                    If sFile2 <> ThisWorkbook.Name Then
                        If Left(sFile2, 1) = "1" Then
                            If j > 5 Then Exit Do
                            Workbooks.Open Filename:=sPath2 & sFile2
                            Set rgG = ActiveSheet.Cells.Find(What:=rgC6.Value)
                            If Not rgG Is Nothing Then
                                j = j + 1
                                If rgC6.EntireRow.Cells(1, "G").Value = "" Then
                                    rgC6.EntireRow.Cells(1, "G").Value = Split(sFile2, ".")(0)
                                Else
                                    rgC6.EntireRow.Cells(1, sh.Columns.Count).End(xlToLeft).Offset(, 1).Value = Split(sFile2, ".")(0)
                                End If
                            End If
                            Workbooks(sFile2).Close False
                        End If
                    End If
                    sFile2 = Dir
                Loop
            End If
        Next rgC6
        
    Next rgC5
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Completed processing all numbers down the 'A' column.", vbInformation

End Sub

[Leif]

Brilliant, Rudi - that's terrific. Did anyone tell you that you were quite good at this?

A couple of points:

It seems to bomb out at

Code: Select all

Application.Intersect(sh.Range("A1").CurrentRegion, sh.Range("A1").CurrentRegion.Offset(1, 1)).ClearContents

if the range is clear in the first place, and I had to add a

Code: Select all

Application.AskToUpdateLinks = False

routine to stop it asking me several times!

Other than that, it takes around 14 minutes per 5* number, which is acceptable for an unattended application. With this great start, when I get time I am going to see if I can get it to loop through all 6* files in one pass, then all 1* files in a single pass, as it could be a great utility for us. I'm also going to add options like how many results are required - in the majority of cases, I suspect that one 5* will lead to one 6* and then a single 1*.

(I also found copy the files to search to a local drive made a big difference in time!)

Thanks again - I'm going to run it on an extended trial and see what I get in the morning!

[Rudi]

Glad its doing what was expected.

The clearing of the range is something I added almost right at the end. Actually it is not really necessary as the 6* and 1* files overwrite the entries if they happen to exist. I just thought its cleaner to clear it first. To fix that you can just use an On Error Resume Next and an On Error GoTo 0 above and below it.

It's still rough around the edges and a lot of improvement can still be done on it to optimize it... We'll be happy to provide more assistance if needed.