Search string and return file name and Path

[Shanmugam]

Hi,

I am looking for a VBA Excel code to find a set of strings and return file name and path. The string may be in any of the sub folders and code should return the exact file name and path to show where it is located.

For e.g. I have a spread sheet with a list of check numbers (number or text) available in column A, i.e. from cell A2 to A20. The code should execute and select a master path then it should return the file name and file path to show where the check number is located.

Appreciate your help on this.

Thank you,
Shan

[Leith Ross]

Hello Shan,

Is the check number part of the file name?

Is the starting directory (folder) the same as the workbook with the check numbers?

[Shanmugam]

Hi Leith,

The check number will be in any of the tab and in any of the column under that tab. If the specific check number found, then, the output of the 2 columns in the input should have file name and file path respectively.

The file may exists in any of the folder. For an example, I may run the macro spreadsheet from the desktop and the searched file (say 1 check) may be available in d://records/2015/Jan/ and the other check will be in d://records/2016/Feb/.. something like this.

Thank you,
Shan

[Leith Ross]

Hello Shan,

It seems the macro should let you choose which folder to you want to start the search in. Will the search be just for xlsx workbooks or xlsm or both?

[Shanmugam]

Hi Leith,

The search would be in both xls and xlsx.

Thank you,
Shan

[Leith Ross]

Hello Shan,

There are two macros for this task. The first macro "GetFiles" recursively searches the parent folder, the one you choose to start with, and all it's sub-folders for workbooks with an XLS or XLSX etension and returns an array of file objects.

The second macro "FindChecks" step through the array "FileList" and opens each file. Once open, the macro checks each worksheet in the workbook for each check number listed in column "A". When a match is found, the file name, file path, sheet name and cell address are returned to cells to the right of the check number.

On "Sheet1" of the attached workbook. I have added a button to run the macro. Let me know if this is close to what you wanted.

Module1 Code


Private FileList As Variant
Private oShell As Object

Function GetFiles(ByVal Folder As Variant)

Dim File As Object
Dim Files As Object
Dim SubFolder As Object
Dim SubFolders As Object

If oShell Is Nothing Then Set oShell = CreateObject("Shell.Application")

Set Folder = oShell.Namespace(Folder)

Set Files = Folder.Items
Files.Filter 64, "*.xls;*.xlsx"

If VarType(FileList) = vbEmpty Then ReDim FileList(0)

For Each File In Files
Set FileList(UBound(FileList)) = File
ReDim Preserve FileList(UBound(FileList) + 1)
Next File

Set SubFolders = Folder.Items
SubFolders.Filter 32, "*"

For Each SubFolder In SubFolders
Call GetFiles(SubFolder.Path)
Next SubFolder

GetFiles = FileList

End Function

Sub FindChecks()

Dim Cell As Range
Dim CheckCell As Range
Dim File As Variant
Dim Folder As Variant
Dim MainRng As Range
Dim n As Long
Dim MainWks As Worksheet
Dim Wkb As Workbook
Dim Wks As Worksheet

Set MainWks = ThisWorkbook.Worksheets("Sheet1")

Set MainRng = MainWks.Range("A1").CurrentRegion
Set MainRng = Intersect(MainRng, MainRng.Offset(1, 0))

If MainRng Is Nothing Then Exit Sub

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Folder = .SelectedItems(1)
End With

Application.ScreenUpdating = False

FileList = Empty
FileList = GetFiles(Folder)

If UBound(FileList) = 0 Or VarType(FileList) = vbEmpty Then
MsgBox "No XLS or XLSX files were found in the folder """ & Folder & """ or it's Subfolders.", vbExclamation
Application.ScreenUpdating = True
Exit Sub
End If

For n = 0 To UBound(FileList) - 1
DoEvents
Set Wkb = Workbooks.Open(FileList(n).Path)

For Each Wks In Wkb.Worksheets
For Each Cell In MainRng.Columns(1).Cells
Set CheckCell = Wks.Cells.Find(Cell.Value, , xlValues, xlWhole, xlByRows, xlNext, False, False, False)

If Not CheckCell Is Nothing Then
Cell.Resize(1, 4).Value = Array(Wkb.Name, Wkb.Path, Wks.Name, Cell.Address)
End If
Next Cell
Next Wks

Wkb.Close SaveChanges:=False
Next n

Application.ScreenUpdating = True

End Sub

[Shanmugam]

Hi Leith,

Thank you for the script. I ran the macro, but, the didn't return the result, i.e. there is no results found in the desired columns. Also, I have noticed 2 issues,

1. Longer time: It look 7 mins to search (however no results found) to search 4 check details out of 153 excel spreadsheets, whereas, I am eventually going to search about nearly 5000 checks with 10,000 spreadsheets and I cant imagine the number of hours it may took to get the desire output. The macro search opens up each spreadsheet from the parent directory and I am not sure if this is really needed and may cause the slowness.

2. I have also noticed that the same checks may found in multiple spreadsheet, so, i am thinking of how to display the results when same check found in multiple spreadsheets/files.

I really appreciate if you could help me resolve these issues.

[Leith Ross]

Hello Shan,

I have spent quite a bit of time testing and refining the macros. This workbook is the result. Do not be mislead by the length of the code into believing it must be slow. Optimized code often requires using more advanced code techinques to exploit both software and hardware.

The biggest challenge was dealing with zipped folders. The code will handle a zipped folder that does not contain other zipped folders. If this type of folder is encountered then the macro will error and stop. This type of error can not be trapped.

Here is the workbook and the macro code used. The layout is same as the previous posts.

Moudle1 Code


Global oShell As Object
Private FileList As Variant

Function GetFiles(ByVal Folder As Variant)

Dim File As Object
Dim Files As Object
Dim SubFolder As Object
Dim SubFolders As Object

If oShell Is Nothing Then Set oShell = CreateObject("Shell.Application")

Set Folder = oShell.Namespace(Folder)

Set Files = Folder.Items
Files.Filter 64, "*.xls;*.xlsx"

If VarType(FileList) = vbEmpty Then ReDim FileList(0)

For Each File In Files
Set FileList(UBound(FileList)) = File
ReDim Preserve FileList(UBound(FileList) + 1)
Next File

Set SubFolders = Folder.Items
SubFolders.Filter 32, "*"

For Each SubFolder In SubFolders
Call GetFiles(SubFolder.Path)
Next SubFolder

GetFiles = FileList

End Function

Sub FindChecks()

Dim c As Long
Dim Cell As Range
Dim Check As Variant
Dim Checks As Object
Dim CheckRng As Range
Dim Data As Variant
Dim File As Variant
Dim Folder As Variant
Dim n As Long
Dim MainWks As Worksheet
Dim r As Long
Dim RngBeg As Range
Dim RngEnd As Range
Dim Wkb As Workbook
Dim Wks As Worksheet

Set MainWks = ThisWorkbook.Worksheets("Sheet1")

Set CheckRng = MainWks.Range("A1").CurrentRegion.Columns(1)
Set CheckRng = Intersect(CheckRng, CheckRng.Offset(1, 0))

If CheckRng Is Nothing Then Exit Sub

MainWks.UsedRange.Offset(1, 1).ClearContents

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Folder = .SelectedItems(1)
End With

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

FileList = Empty
FileList = GetFiles(Folder)

If UBound(FileList) = 0 Or VarType(FileList) = vbEmpty Then
MsgBox "No XLS or XLSX files were found in the folder """ & Folder & """ or it's Subfolders.", vbExclamation
Application.ScreenUpdating = True
Exit Sub
End If

Set Checks = CreateObject("Scripting.Dictionary")
Checks.CompareMode = vbTextCompare

For Each Check In CheckRng.Cells
If Not Checks.Exists(Check.Value) Then
Checks.Add Check.Value, Check
End If
Next Check

For n = 0 To UBound(FileList) - 1
DoEvents

' Check if folder zipped.
If FileList(n).Parent.Self.Type Like "*zipped*" Then
UnzipFolder FileList(n).Parent.Self.Path
Set Folder = oShell.Namespace(Environ("TEMP") & "\Unzip")

For Each File In Folder.Items
Set Wkb = Workbooks.Open(File.Path)
GoSub SearchWorksheets
Wkb.Close SaveChanges:=False
Next File
Else
Set Wkb = Workbooks.Open(FileList(n).Path)
GoSub SearchWorksheets
Wkb.Close SaveChanges:=False
End If
Next n

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Exit Sub


SearchWorksheets:

For Each Wks In Wkb.Worksheets
Set RngBeg = Wks.Cells.Find("*", Wks.Cells(Rows.Count, Columns.Count), xlFormulas, xlPart, xlByColumns, xlNext, False, False, False)

If Not RngBeg Is Nothing Then
r = Wks.Cells.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious, False, False, False).Row
c = Wks.Cells.Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious, False, False, False).Column
Set RngEnd = Wks.Cells(r, c)
End If

On Error Resume Next
Data = Wks.Range(RngBeg, RngEnd).Value

If Err = 0 Then
For r = 1 To UBound(Data, 1)
For c = 1 To UBound(Data, 2)
If Checks.Exists(Data(r, c)) Then
With Checks(Data(r, c)).Offset(0, 1)
Fields = Array(.Offset(0, 0) & Wkb.Name & "*", _
.Offset(0, 1) & FileList(n).Parent.Self.Path & "*", _
.Offset(0, 2) & Wks.Name & "*", _
.Offset(0, 3) & RngBeg.Offset(r - 1, c - 1).Address & "*")
.Resize(1, 4).Value = Fields
End With
End If
Next c
Next r
End If

On Error GoTo 0
Next Wks

Return

End Sub


UnZip_Folder Code


Sub UnzipFolder(ByVal zipPath As Variant)

Dim File As Variant
Dim Files As Variant
Dim Folder As Variant
Dim Target As Variant

' Unzip files in the Zip folder to "C:\..\Temp\Unzip" in the users account.
'
' Written: April 26, 2016
' Author: Leith Ross

If Module1.oShell Is Nothing Then Set Module1.oShell = CreateObject("Shell.Application")

With oShell
Set Folder = .Namespace(zipPath)

Set Target = .Namespace(Environ("TEMP") & "\Unzip\")
' Create the directory if it is missing.
If Target Is Nothing Then
MkDir Environ("TEMP") & "\Unzip"
End If

' Send any files in the Target directory to the Recycle Bin.
If Target.Items.Count > 0 Then
.Namespace(10).MoveHere Target.Items, 68
End If

' The Shell automatically unzips the files in the Zip folder when copied or moved.
Set Files = Folder.Items

Files.Filter 64, "*.xls;*.xlsx"

For Each File In Files
.Namespace(Target).CopyHere File, 76
Next File
End With

End Sub

[Shanmugam]

Thank you so much Leith. Unfortunately, I am still encountering 2 issues.

1. The searching check# is available in the searched spread sheet but still our input file is still not recognizing and showing results, I doubt that this could be due to the number format issue, because, my input cell value is in "text" format but the actual file cell value check# is in "general" format. I am not too sure about this. The reason behind is, when I search "number" to "number", it is showing result but if the format is not is same as in the input/search file, the result is not coming up.

2. The check# is in multiple file, but, result is showing 1 path and not multiple path where the other check# is located in another path.

Thanks again for all the help you are providing.

[Leith Ross]

Hello Shan,

What type of file is your input file? The macro expects all files to be Excel workbooks of the type XLS or XLSX. Any other file type is ignored.

The search value is typed as a Variant. It does not care if it is a number or text. However, if you have leading or trailing spaces in the cell then a match may not happen. I can add code to remove any leading or trailing spaces but this will slow the macro code down. When it comes to search success, consistency is the key.

In my testing of the new code, I did not encounter problem #2. Can you provide me with an example from one of your test runs?

[Shanmugam]

Hi Leith,

Please find attached the example. Kindly search this check after placed it in the folder and see if you can run the macro and find the path and other details. Also, place the same file in any other folder and see if you're getting multiple folder details as well (this for #2).

[Leith Ross]

Hello Shan,

The macro will now search for both a text and number version for the checks. Try out the attached workbook or update your original with the corrected Module1 code shown. Let me know the reults.

Module1 Code


Global oShell As Object
Private FileList As Variant

Function GetFiles(ByVal Folder As Variant)

Dim File As Object
Dim Files As Object
Dim SubFolder As Object
Dim SubFolders As Object

If oShell Is Nothing Then Set oShell = CreateObject("Shell.Application")

Set Folder = oShell.Namespace(Folder)

Set Files = Folder.Items
Files.Filter 64, "*.xls;*.xlsx"

If VarType(FileList) = vbEmpty Then ReDim FileList(0)

For Each File In Files
Set FileList(UBound(FileList)) = File
ReDim Preserve FileList(UBound(FileList) + 1)
Next File

Set SubFolders = Folder.Items
SubFolders.Filter 32, "*"

For Each SubFolder In SubFolders
Call GetFiles(SubFolder.Path)
Next SubFolder

GetFiles = FileList

End Function

Sub FindChecks()

Dim c As Long
Dim Cell As Range
Dim Check As Range
Dim Checks As Object
Dim CheckRng As Range
Dim Data As Variant
Dim File As Variant
Dim Folder As Variant
Dim n As Long
Dim MainWks As Worksheet
Dim r As Long
Dim RngBeg As Range
Dim RngEnd As Range
Dim Wkb As Workbook
Dim Wks As Worksheet

Set MainWks = ThisWorkbook.Worksheets("Sheet1")

Set CheckRng = MainWks.Range("A1").CurrentRegion.Columns(1)
Set CheckRng = Intersect(CheckRng, CheckRng.Offset(1, 0))

If CheckRng Is Nothing Then Exit Sub

MainWks.UsedRange.Offset(1, 1).ClearContents

With Application.FileDialog(msoFileDialogFolderPicker)
.Show
If .SelectedItems.Count = 0 Then Exit Sub
Folder = .SelectedItems(1)
End With

FileList = Empty
FileList = GetFiles(Folder)

If UBound(FileList) = 0 Or VarType(FileList) = vbEmpty Then
MsgBox "No XLS or XLSX files were found in the folder """ & Folder & """ or it's Subfolders.", vbExclamation
Application.ScreenUpdating = True
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set Checks = Nothing
Set Checks = CreateObject("Scripting.Dictionary")
Checks.CompareMode = vbTextCompare

For Each Check In CheckRng.Cells
If Not Checks.Exists(Check.Value) Or Not Checks.Exists(Check.Text) Then
On Error Resume Next
Checks.Add Val(Check.Value), Check
Checks.Add Check.Text, Check
On Error GoTo 0
End If
Next Check

For n = 0 To UBound(FileList) - 1
DoEvents

' Check if folder zipped.
If FileList(n).Parent.Self.Type Like "*zipped*" Then
UnzipFolder FileList(n).Parent.Self.Path
Set Folder = oShell.Namespace(Environ("TEMP") & "\Unzip")

For Each File In Folder.Items
Set Wkb = Workbooks.Open(File.Path)
GoSub SearchWorksheets
Wkb.Close SaveChanges:=False
Next File
Else
Set Wkb = Workbooks.Open(FileList(n).Path)
GoSub SearchWorksheets
Wkb.Close SaveChanges:=False
End If
Next n

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Exit Sub


SearchWorksheets:

For Each Wks In Wkb.Worksheets
Set RngBeg = Wks.Cells.Find("*", Wks.Cells(Rows.Count, Columns.Count), xlFormulas, xlPart, xlByColumns, xlNext, False, False, False)

If Not RngBeg Is Nothing Then
r = Wks.Cells.Find("*", , xlFormulas, xlWhole, xlByRows, xlPrevious, False, False, False).Row
c = Wks.Cells.Find("*", , xlFormulas, xlWhole, xlByColumns, xlPrevious, False, False, False).Column
Set RngEnd = Wks.Cells(r, c)
End If

If Not RngBeg Is Nothing And Not RngEnd Is Nothing Then
With Wks.Range(RngBeg, RngEnd)
If .Cells.Count = 1 Then
ReDim Data(1, 1)
Data(1, 1) = .Value
Else
Data = .Value
End If
End With

For r = 1 To UBound(Data, 1)
For c = 1 To UBound(Data, 2)
If Checks.Exists(Data(r, c)) Then
With Checks(Data(r, c)).Offset(0, 1)
Fields = Array(.Offset(0, 0) & Wkb.Name & "*", _
.Offset(0, 1) & FileList(n).Parent.Self.Path & "*", _
.Offset(0, 2) & Wks.Name & "*", _
.Offset(0, 3) & RngBeg.Offset(r - 1, c - 1).Address & "*")
.Resize(1, 4).Value = Fields
End With
End If
Next c
Next r
End If

Next Wks

Return

End Sub

[Shanmugam]

Thank you so much Leith, you are awesome! I have one more issue (I guess, this should be the final one).

The spreadsheet under the search folder do have file 'link' in any of the cell. With this, the search files open up every single time when executing the macro and showing the message box as "Update", "Do not Update". Is there a way you can hit "esc" button for such type files instead of manually select "Do not Update"? Or sometimes it is asking "Yes", "No" to open the file and on that case, it should hit "yes". The reason behind for the request is, I am searching for about 1,000 files and I have click 1,000 times if I get any of the mentioned message box.

[Leith Ross]

Hello Shan,

Sorry for the delay. Are the links you are referring to the links in the workbook to other data sources or hyperlinks on the worksheets? I think it is the former since the workbook will display a message when the workbook opens. I just want to be certain we are talking about the same thing.

[Shanmugam]

Hi Leith,

I am referring to the links in the worksheet that are from the other source of worksheets. After few more testing, the searches are not performing leading zeroes, that is, '00000700048' is in the path folder for the input search check# '700048' does not providing search result, please also look into this.

I have also requested the search results in the path folder instead of separate columns and by separate line item for each duplicate searches in my previous thread along with screen shot attachment, kindly look into that as well.

[Leith Ross]

Hello Shan,

I don't see any screen shot attached to your last post.

[Shanmugam]

Hi Leith,

You are correct, I don't know how it got missed or I have not properly posted that, I am attaching here the screen shot now.

[Leith Ross]

Hello Shan,

Here is the updated workbook. This now kists the found checks on a separate sheet named "Checks Found". The checks are listed from smallest to largest with a separator line between different check numbers.

As for the problem with inputting leading zeroes, you will have to enter them to get a match. Trying to write code to guess what you have input to match a file name would slow execution to crawl.

[Leith Ross]

The case of the disappearing attachments. Let's try this again...

[Shanmugam]

Hi Leith,

Thank you for the updated macro. It does resolve file path item request, search results in a separate line item request and leading zero issue request. However, I ran into the few other issues as below:
1. Link update issue - This item is still not resolved (have attached screen shot to show that)
2. Even if the file is a xls or xlsx, If the spread sheet is not valid or corrupted, macro should skip and move to search others. But currently, it is debugging and closing out of the script. Please see if these types can be skipped and continue running the searches and move one. I have also attached the screen shots to show how it look like.

Also, can we have the macro execution progress shown some where and alert me when the overall search is completed?

Thanks again for all the help you are doing for me.

[Leith Ross]

Hello Shan,

This updated version should handle the remaining issues.

[Shanmugam]

Hi Leith,

Thank you for the updated macro. Some of the issue of the following still appears to be not resolved. I have attached the screen shot for your reference.

Screen shot#1. Link reference issue - This happens when any of the cell contains a reference to one or other file with specific formula or values.

Requested action: Message box will pop-up with 'Update', 'Don't Update', 'Help'. Macro should hit 'Don't update' and keep working without holding and prompting this message box and requires human hit.

Screen shot#2. 'Open' of object 'Workbooks' failed issue - This happens when the file extension is with either xls or xlsx but if you try to open it up, it may not happen because it may not be a valid spreadsheet file.

Requested action: During this time, macro should skip this type of file and keep running and searching for the rest without run-time error

Screen shot#3. Same as above. File appears corrupted and unable to open.

Requested action: Macro should skip these type of files and keep moving/searching to next

Screen shot#4. Reference error to above.

Requested action: Macro should skip these type of files and keep moving/searching to next

I do have few spread sheets where it contains password to open file and during this file, macro should hit read-only and keep moving without waiting for human to hit the button.

Appreciate your help to fix these items.

[Leith Ross]

Hello Shan,

Sorry, I missed changing one of the workbook open statements. I created a corrupt file to test the error trapping and it worked, so should everything else. Use the attached workbook. Let me know the results.

[Shanmugam]

Hi Leith,

Thank you for the updated file. It does resolve the link issue and the corrupted file issue. However, I am getting attached error msg when it searched through zipped folder, if it happen, the macro can skip search and move to the next. Kindly look in to this.

[Tom Jones]

Leith Ross,

Excellent job.

[Leith Ross]

Hello Tom,

Thanks.

[Shanmugam]

Hi Leith,

Please see if the above zip error issue can be resolved.

[Shanmugam]

Hi Leith,

Your help to resolve the above issue will be highly appreciated. This is currently chocking my overall execution process.

[Leith Ross]

Hello Shan,

This version of the workbook ignores Zipped files.

[Shanmugam]

Hi Reith,

It worked well. Thank you for all the help provided to me on this. I still wanted to learn if I come across the similar kind of bugs again and how to resolve it and I think, I will keep explore it in this forum and learn things. See you soon in this same forum again! :)

[Shanmugam]

Closing this thread as solved.

[aeble12]

Hello Leith and Shanmugam,

In testing Leith's code from "Search Check ver 5.xlsm" I discovered that if a user lists values in the Check Number range on Sheet 1 that are strings i.e. a mixture of alpha and numeric characters (not just numeric characters) the program will, upon execution, produce a list of hundreds or thousands of the same string in the "Checks Found" sheet with references to workbooks and cell locations that are null values. In other words, the multiple listings of this string are entirely extraneous. Interestingly, this behavior is associated only with the first occurrence of a string with alpha-numeric characters given on Sheet 1 in the Check Number range; any other alpha-numeric strings listed in the Check Number range on Sheet 1 will be listed the correct number of times to match the files/folders/subfolders in which the search is run and with valid file path and cell address references (no addresses to null values are returned). This glitch does not occur for look up values that are only numeric, regardless of the formatting e.g. "general" or "text" or "number". The glitch only occurs when there is at least one look up value in the Check Number range on Sheet 1 that has a mixture of alpha and numeric characters. I haven't been able to determine why this is so or a solution to the problem. Able to shed some light on this strange glitch? -Anthony

[Leith Ross]

Hello aeble12,

If you can post a sample file or two that demonstrates this problem, I would love to see it. Since you are a new member, you may have to upload the files to a public file hosting site like Dropbox, MediaFire, OneDrive, etc. I think you need to have at least 5 posts before you can upload an attachment.

[fruitymelon]

hi Leith, i know it's an old thread. But somehow i try to find exact value "FALSE" or "False", the excel output not correct. Do you know what to change? Thanks! I'm trying to find from column CG through 100 files.

[poielsd]

Is the check number part of the file name?

Is the starting directory (folder) the same as the workbook with the check numbers?

[fruitymelon]

Do you mean if search for word that is related to filename xlsx, it'll not return correct results? It'll be good if it can check any string in the excel file.

Yes I place the XLSM file in the same folder that I want to search for exact text "False".
Tab "Checks Found" returns invalid cells. I do not want to search for numbers.

I try to key in 'False in Sheet1 and Click button Find Checks, as the cell becomes FALSE instead (boolean). "Checks Found" is still showing invalid cells.