PDA

View Full Version : Solved: Search engine



Airborne
10-24-2004, 07:44 AM
:) Hello, on our server files are saved daily. The files have data in textboxes and in cells. When we want to search back in the files, we use Windows search on the map where we think the file is, which contains the data we are looking for.
The question is, is it possible and if so does anyone have a code for a search engine in Excel? So when you hit a button a form will open where you type the word you are looking for and a search will start through the stored files.:eek:

Jacob Hilderbrand
10-24-2004, 02:13 PM
Try this:

http://www.vbaexpress.com/kb/getarticle.php?kb_id=159

Airborne
10-24-2004, 02:51 PM
:pleased: Jacob this is a great code! The problem is and I'm sorry I have not been clear enough, the words I have to search for are in textboxes in the sheets. We type text in textboxes in the sheets. I've tried the code and it's great for finding data in cells but can I adjust it in a way that it can search for words in textboxes?:blush


Thanks for the help.

Jacob Hilderbrand
10-24-2004, 05:55 PM
Instead of getting the search word from the Input Box you can use something like this:
Search = Sheet1.TextBox1.Text

Airborne
10-25-2004, 01:32 AM
:blush I'm sorry Jacob. I'm not sure I understand. The names of the sheet in the workbooks we save are Data. In your code I've tried Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = Sheets("Data").TextBox1.Text
If Search = "" Then
GoTo Canceled
End If

But I get an error. Also there are 6 textboxes (5, 21, 22, 23, 24, 26).

Jacob Hilderbrand
10-25-2004, 01:58 AM
But I get an error. Also there are 6 textboxes (5, 21, 22, 23, 24, 26).

Don't refer to the Textbox as Textbox1 if that is the wrong name:

Textbox5
Textbox21
Textbox22
Textbox23
Textbox24
Textbox26

Airborne
10-25-2004, 02:23 AM
Jacob, I've tried Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = Sheets("Data").TextBox22.Text
Search = Sheets("Data").TextBox23.Text
' InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If

I get subscript out of range. It wants to search for the workbook name "Data" I guess. The names of the stored files are by date, e.g. 21-10-2004, 22-10-2004, etc. So there are about 30 - 31 files per month stored, in this case in the map Oct. The names of the sheet in the workbooks are called Data and they contain the textboxes:eek:

Jacob Hilderbrand
10-25-2004, 03:41 AM
So you want to check each workbook in a folder and check certain Text Boxes (in each workbook) for a certain text string?

Jacob Hilderbrand
10-25-2004, 03:57 AM
See if this helps you get started.

Dim WB As Workbook
Dim FileName As String

FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
If Err = 0 Then
On Error GoTo 0
With WB.Sheets("Data")

'Check the values in the Text Boxes here

End With
End If
On Error GoTo 0
WB.Close False
FileName = Dir()
Loop

Airborne
10-25-2004, 05:14 AM
Sorry Jacob, I'm just a beginner and I'm lost now. The last code and the first code look like this nowOption Compare Text
Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long

Function BrowseFolder(Optional Caption As String = "") As String

Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long

With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If

End Function

Sub FindAll()

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim Search As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As String
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult
Dim FileName As String

'*** Get folder from user ***
' Prompt = "Select the folder with the files that you want to search through." & _
' vbNewLine & vbNewLine & "Note: Subfolders will not be searched through."
Title = "Folder Selection"
' MsgBox Prompt, vbInformation, Title

'*** This code works with XP only and is also used to pick a folder ***
'Application.FileDialog(msoFileDialogFolderPicker).Show
'Path = CurDir

Path = BrowseFolder("Select A Folder")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
GoTo Canceled:
End If

' Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If

'*** Confirm the procedure before continuing ***
' Prompt = "Are you sure that you want to search all the files in the folder:" & _
' vbCrLf & Path & " for " & """" & Search & """" & "?"
Title = "Confirm Procedure"
' MyResponse = MsgBox(Prompt, vbQuestion + vbYesNo, Title)
' If MyResponse = vbNo Then
' GoTo Canceled:
' End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'*** Loop through all Word documents and search each of them for the specified criteria***
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
If Err = 0 Then
On Error GoTo 0
With WB.Sheets("Data")

'Check the values in the Text Boxes here

End With
End If
On Error GoTo 0
WB.Close False
FileName = Dir()
Loop
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub But where you say 'Check the values in the Text Boxes here. I don't know what to put there.:eek:

Jacob Hilderbrand
10-25-2004, 05:47 AM
Try something like this
With WB.Sheets("Data")

'Check the values in the Text Boxes here
If .TextBox5.Text = Search Then
'Do Something
Else
'Not Found
End If
If .TextBox21.Text = Search Then
'Do Something
Else
'Not Found
End If
If .TextBox22.Text = Search Then
'Do Something
Else
'Not Found
End If



End With

Airborne
10-25-2004, 06:11 AM
:bawl After I've selected the directory and entered the word I want to look for, it just opens a .xls file in the directory and then in line If .TextBox5.Text = Search Then I get the error "object doesn't support this property of method".

It should also, only open a file, if the word where I searched for is found.

:no I think this is more VBA than I can handle.

Thanks for the help.

Jacob Hilderbrand
10-25-2004, 06:46 PM
Ok, try this one. Note that there is currently no error handling to take care of the Text Boxes possibly not existing on the Sheet named Data in each workbook.

Option Compare Text
Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long

Function BrowseFolder(Optional Caption As String = "") As String

Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long

With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If

End Function

Sub FindAll()

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim Search As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As String
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult
Dim FileName As String

'*** Get folder from user ***
' Prompt = "Select the folder with the files that you want to search through." & _
' vbNewLine & vbNewLine & "Note: Subfolders will not be searched through."
Title = "Folder Selection"
' MsgBox Prompt, vbInformation, Title

'*** This code works with XP only and is also used to pick a folder ***
'Application.FileDialog(msoFileDialogFolderPicker).Show
'Path = CurDir

Path = BrowseFolder("Select A Folder")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
GoTo Canceled:
End If

Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If

'*** Confirm the procedure before continuing ***
' Prompt = "Are you sure that you want to search all the files in the folder:" & _
' vbCrLf & Path & " for " & """" & Search & """" & "?"
Title = "Confirm Procedure"
' MyResponse = MsgBox(Prompt, vbQuestion + vbYesNo, Title)
' If MyResponse = vbNo Then
' GoTo Canceled:
' End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'*** Loop through all Word documents and search each of them for the specified criteria***
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
On Error GoTo 0
'Cannot Open Workbook
If WB Is Nothing Then
GoTo NextLoop:
End If
On Error Resume Next
Set WS = WB.Sheets("Data")
On Error GoTo 0
If WS Is Nothing Then
WB.Close False
GoTo NextLoop:
End If
With WB.Sheets("Data")
'Check the values in the Text Boxes here
If .TextBox5.Text = Search Or _
.TextBox21.Text = Search Or _
.TextBox22.Text = Search Or _
.TextBox23.Text = Search Or _
.TextBox24.Text = Search Or _
.TextBox26.Text = Search Then
'Do Something
'Just keep the file open
Else
'Not Found
WB.Close False
End If
End With

NextLoop:
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Loop
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Airborne
10-26-2004, 07:49 AM
:blush :blush You must be getting tired of my replies but it doesn't work. I get the error message "object doesn't support this property of method".

What do you mean by "Note that there is currently no error handling to take care of the Text Boxes possibly not existing on the Sheet named Data in each workbook"?

What I don't understand is that the routine just opens .xls files in the selected directory. It must open a file only, when it finds the text I'm searching for in one of the textboxes, on the sheet named Data, in the workbook Data_ddmmjjj.

In the directory are about 30 - 31 workbooks named Data_ddmmjjj all containing 3 sheets and one of those sheets is called Data containing the mentioned textboxes.:wot I hope I'm clear enough :blush .

Thanks for your patience.

mdmackillop
10-26-2004, 10:26 AM
Hi,
Try the following variation of the FindAll sub. It does depend upon how your system names the textboxes. If there is a problem, can you zip up a workbook containing a suitable "Data" page and post it here. (You can delete all the data on the sheet if you wish, as it is unnecessary)


Sub FindAll()

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim Search As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As String
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult
Dim FileName As String
Dim Test As Boolean
Dim MyWS
Dim shp
Dim i As Integer
Dim BoxText As String

'*** Get folder from user ***
' Prompt = "Select the folder with the files that you want to search through." & _
' vbNewLine & vbNewLine & "Note: Subfolders will not be searched through."
Title = "Folder Selection"
' MsgBox Prompt, vbInformation, Title

'*** This code works with XP only and is also used to pick a folder ***
'Application.FileDialog(msoFileDialogFolderPicker).Show
'Path = CurDir

Path = BrowseFolder("Select A Folder")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
GoTo Canceled:
End If

Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
Search = InputBox(Prompt, Title)
If Search = "" Then
GoTo Canceled
End If

'*** Confirm the procedure before continuing ***
' Prompt = "Are you sure that you want to search all the files in the folder:" & _
' vbCrLf & Path & " for " & """" & Search & """" & "?"
Title = "Confirm Procedure"
' MyResponse = MsgBox(Prompt, vbQuestion + vbYesNo, Title)
' If MyResponse = vbNo Then
' GoTo Canceled:
' End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'*** Loop through all Word documents and search each of them for the specified criteria***
FileName = Dir(Path & "\*.xls", vbNormal)

Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
On Error GoTo 0
'Cannot Open Workbook
If WB Is Nothing Then
GoTo NextLoop:
End If
On Error Resume Next
Set WS = WB.Sheets("Data")
On Error GoTo 0
If WS Is Nothing Then
WB.Close False
GoTo NextLoop:
End If
Set MyWS = WB.Sheets("Data")
Test = False
'Check the values in the Text Boxes here
For i = 1 To MyWS.Shapes.Count
' Debug.Print MyWS.Shapes(i).Name
BoxText = MyWS.Shapes(i).TextFrame.Characters.Text
If Left(MyWS.Shapes(i).Name, 8) = "Text Box" Then
If InStr(1, BoxText, Search) > 0 Then
Test = True
GoTo NextLoop
End If
End If
Next

NextLoop:
If Test = False Then WB.Close False
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Debug.Print FileName
Loop
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Airborne
10-26-2004, 11:46 AM
:dunno Still not working, it just opens the first file where the text is not in and then returns the error I mentioned before. I'll attach a zipped file.

mdmackillop
10-26-2004, 11:57 AM
Anticipated problem with the TextBox names,
Change this line
If Left(MyWS.Shapes(i).Name, 8) = "Text Box" Then

to
If Left(MyWS.Shapes(i).Name, 4) = "Text" Then

I've not set the code to check sheets only named Data.... Is this required?

Airborne
10-26-2004, 12:44 PM
:bawl No, it just opens a file (it doesn't seem to bother about the text I search for) and then I get the usual error but now at line "BoxText = MyWS.Shapes(i).TextFrame.Characters.Text".:thinking:

mdmackillop
10-26-2004, 12:48 PM
It may be a version problem, I'm on 2000. What version of Excel are you using?

Airborne
10-26-2004, 12:51 PM
I use 2003 and WindowsXP

Ken Puls
10-26-2004, 04:12 PM
Hi Airborne,

I've just tested the code using the workbook you provided, and the code pulled from posts by DRJ and mdmackillop above (inlcluding md's change re the text vs textbox).

I'm running XL2003 on Win XP also, and the code fires for me just fine.

Just to check... (I tried to follow the thread, but there's a lot to read) You are firing this code from a workbook different than the one you attached here, with the attached version being the target that you're searching?

I have a few of questions for you on your target wb's:
-Are they created from a template, or do users create them on their own?
-How are you creating the textboxes in the sheets? (From Control toolbox or somewhere else?)
-What is your code supposed to do when it finds a match? Currently it seems to do a debug.print on the NEXT file in the list, but does nothing with the match
-FYI You also have a potential issue in that your code calls:
Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True, Password:="DRJWasHere")
On Error Goto 0
'Cannot Open Workbook
If WB Is Nothing Then
Goto NextLoop:

'More code here

NextLoop:
If Test = False Then WB.Close False
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Debug.Print FileName
Loop

The issue is that if WB is nothing, you can't close it, so it will error out. This is also the section that led into the question about what's supposed to happen too. I would have expected to see the debug.print line above the set WB=nothing, but then again, I'm not really sure of what you're after.

Ken Puls
10-26-2004, 07:36 PM
Re post above...

Please check here http://www.vbaexpress.com/forum/showthread.php?t=1213. You may want to try coding around an OLEObject instead of a shapes object. I don't know if this is the issue or not, but I ran into error at the same place you did when trying to use a textbox created from the Control Toolbox. (The posted code worked fine with the file you suppliedthough, which is the reason for my question above about who is creating and how.) My gut leads me there...

I don't think (although could be proven wrong):yes that it is a version issue, as usually code created in lower versions should run without issue in later versions. Since your version is higher than md's, it should be okay.

FYI, I'll be in a seminar all day tomorrow, but will try and check tomorrow night to see what progress has been made.:vv

Cheers,

Airborne
10-27-2004, 07:02 AM
Hello, sorry for the late reply:blush.
To answer your questions....

-Are they created from a template, or do users create them on their own?
The sheets are created from a template.
The two sheets are copied and saved in a workbook with the name format ddmmjjj. The sheets in the template already have the textboxes and we just type our comments in the textboxes.

-How are you creating the textboxes in the sheets? (From Control toolbox or somewhere else?)
The textboxes were created from the Drawing bar, you can insert textboxes.

-What is your code supposed to do when it finds a match? Currently it seems to do a debug.print on the NEXT file in the list, but does nothing with the match
You are right but at the end of the day I just want to find a word in the textboxes of the saved files. In one of the files someone typed "K100 loaded". Now if for some reason we want to know when "K100" was loaded it would be a lot of work to open 30 files. My wish is to use the search engine which will search through the files and then only open the file where the word "K100" is typed in one of the textboxes.

Thanks for the help.

Ken Puls
10-28-2004, 10:27 AM
Hi Airborne.

Sorry for the late reply as well. I've gone through and tested your code, and it all seems to run just fine for me, with the exceptions I already noted in previous posts. Here's the way I tested it, so tell me if anything is different:

-Made a new blank workbook and copied in the code from the previous posts. Saved this file as "J:\VBA Tests\Airborne.xls"
-Downloaded an saved your file to "J:\Data15-10-2004.xls"
(I originally put "Airborne" in the same directory as the data file, but that caused me some issues as it ended up trying to open itself.)

-Stepped through the code (in "J:\VBA Tests\Airborne.xls") searching files in "J:\" for the following text strings:
-test
-We type
-Search for
-Every one returned results as expected by the code.

I don't know what else to tell you except that I have posted the full code I used to test (that I assembled from various posts), and have also attached a screenshot of the references that I have set to run this. You may want to check those out as well. (Tools | References in the VBE)

I did check all of the textboxes, and they are certainly all shapes, so that seems okay.

Otherwise, maybe it has something to do with the code placement? Where is the code located in your workbook (what module), and what workbook is it that actually holds the code to run it? Are there any other VBA routines in there that could be causing the conflict? A routine called BoxText, for example? Are any other files open at the time? (I'm shooting in the dark here...:dunno )

Option Compare Text
Option Explicit

Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260

Type BrowseInfo
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszINSTRUCTIONS As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long

Function BrowseFolder(Optional Caption As String = "") As String

Dim BrowseInfo As BrowseInfo
Dim FolderName As String
Dim ID As Long
Dim Res As Long

With BrowseInfo
.hOwner = 0
.pidlRoot = 0
.pszDisplayName = String$(MAX_PATH, vbNullChar)
.lpszINSTRUCTIONS = Caption
.ulFlags = BIF_RETURNONLYFSDIRS
.lpfn = 0
End With
FolderName = String$(MAX_PATH, vbNullChar)
ID = SHBrowseForFolderA(BrowseInfo)
If ID Then
Res = SHGetPathFromIDListA(ID, FolderName)
If Res Then
BrowseFolder = Left$(FolderName, InStr(FolderName, _
vbNullChar) - 1)
End If
End If

End Function
Sub FindAll()

Dim WB As Workbook
Dim WS As Worksheet
Dim Cell As Range
Dim Prompt As String
Dim Title As String
Dim search As String
Dim FindCell() As String
Dim FindSheet() As String
Dim FindWorkBook() As String
Dim FindPath() As String
Dim FindText() As String
Dim Counter As Long
Dim FirstAddress As String
Dim Path As String
Dim MyResponse As VbMsgBoxResult
Dim FileName As String
Dim test As Boolean
Dim MyWS
Dim shp
Dim i As Integer
Dim boxtext As String

'*** Get folder from user ***
' Prompt = "Select the folder with the files that you want to search through." & _
' vbNewLine & vbNewLine & "Note: Subfolders will not be searched through."
Title = "Folder Selection"
' MsgBox Prompt, vbInformation, Title

'*** This code works with XP only and is also used to pick a folder ***
'Application.FileDialog(msoFileDialogFolderPicker).Show
'Path = CurDir

Path = BrowseFolder("Select A Folder")
If Path = "" Then
Prompt = "You didn't select a folder. The procedure has been canceled."
Title = "Procedure Canceled"
MsgBox Prompt, vbCritical, Title
GoTo Canceled:
End If

Prompt = "What do you want to search for in the folder: " & vbNewLine & vbNewLine & Path
Title = "Search Criteria Input"
search = InputBox(Prompt, Title)
If search = "" Then
GoTo Canceled
End If

'*** Confirm the procedure before continuing ***
' Prompt = "Are you sure that you want to search all the files in the folder:" & _
' vbCrLf & Path & " for " & """" & Search & """" & "?"
Title = "Confirm Procedure"
' MyResponse = MsgBox(Prompt, vbQuestion + vbYesNo, Title)
' If MyResponse = vbNo Then
' GoTo Canceled:
' End If

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'*** Loop through all Word documents and search each of them for the specified criteria***
FileName = Dir(Path & "\*.xls", vbNormal)

Do Until FileName = ""
On Error Resume Next
Set WB = Workbooks.Open(FileName:=Path & "\" & FileName, ReadOnly:=True) ', Password:="DRJWasHere"
On Error GoTo 0
'Cannot Open Workbook
If WB Is Nothing Then
GoTo NextLoop: 'PROBLEM HERE
End If
On Error Resume Next
Set WS = WB.Sheets("Data")
On Error GoTo 0
If WS Is Nothing Then
WB.Close False
GoTo NextLoop:
End If
Set MyWS = WB.Sheets("Data")
test = False
'Check the values in the Text Boxes here
For i = 1 To MyWS.Shapes.Count
Debug.Print MyWS.Shapes(i).Name
boxtext = MyWS.Shapes(i).TextFrame.Characters.Text
If Left(MyWS.Shapes(i).Name, 5) = "Text " Then
If InStr(1, boxtext, search) > 0 Then
test = True
GoTo NextLoop
End If
End If
Next

NextLoop:
If test = False Then WB.Close False
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Debug.Print FileName
Loop
Canceled:

Set WB = Nothing
Set WS = Nothing
Set Cell = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Airborne
10-30-2004, 04:21 AM
Happiness is here again:yay :dance: . Thanks:ipray: Ken (and Jacob and mdmackillop) for all the trouble.


Summary: Ken I tried your last routine with the sheets and it worked. But when I copied a few original files to the directory I got errors like the ones mentioned before (inl line vbmenu_register("postmenu_10237", true); "boxtext = MyWS.Shapes(i).TextFrame.Characters.Text" and "If test = False Then WB.Close False. :bawl
But there are no macro's in the workbooks and are absolutely the same as the files already there:confused:

To find the errors I added Goto NextLoop:
End If
On Error Resume Next 'added
Set MyWS = WB.Sheets("Data")
test = False
'Check the values in the Text Boxes here
For i = 1 To MyWS.Shapes.Count
Debug.Print MyWS.Shapes(i).Name
boxtext = MyWS.Shapes(i).TextFrame.Characters.Text
If Left(MyWS.Shapes(i).Name, 5) = "Text " Then
If InStr(1, boxtext, search) > 0 Then
test = True
Goto NextLoop
End If
End If
Next

NextLoop: On Error Resume Next 'added
If test = False Then WB.Close False
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Debug.Print FileName
Loop


After adding the code it worked! So there must be errors in the routine but since I'm only a beginner I don't know where the errors are. It is working perfectly.:D


My next request is:
1) I want a counter added that counts the files that have hits and after the search (the files it found are minimized in the taskbar), a msgbox must pop up telling how many files were found.

2) I don't want the user to select a map to look in but to make the routine follow a default route to the network. When users start the macrol a form will pop up where the type in the month and the word to search for and then the searching starts. So our network name is \\Disc1\StockData (file://\Disc1StockData). So the routine has to go here. Our data sheets are saved by date every day in the map called by month (e.g. Jan, Feb, etc.).

:wot I hope I'm clear enough and not to greedy:blush

Airborne
10-30-2004, 07:00 AM
:giggle Found the problem. Test is declared as Boolean. But where I got errors I read "test". Changed to "Test", removed On error Resume Next and no errors.


P.S. My requests still stand;) .

Ken Puls
10-30-2004, 09:26 PM
Hi Airborne,

I'll hit your first question in this post, then go back and look at your next one.

You'll need to add the line "dim x as integer" to the declarations section of your code. From your last post, take your code, and try changing it to this:

Goto NextLoop:
End If
On Error Resume Next 'added
Set MyWS = WB.Sheets("Data")
test = False 'Check the values in the Text Boxes here
For i = 1 To MyWS.Shapes.Count
Debug.Print MyWS.Shapes(i).Name 'you don't actually need this line
boxtext = MyWS.Shapes(i).TextFrame.Characters.Text
If Left(MyWS.Shapes(i).Name, 5) = "Text " Then
If InStr(1, boxtext, search) > 0 Then
test = True
Goto NextLoop
End If
End If
Next

NextLoop: On Error Resume Next
If test = False Then
WB.Close False
Else
x = x +1 'count opened files using x as variable
End If
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Debug.Print FileName
Loop
msgbox x & " files were found which matched your search term!",vbokonly + vbinformation, x & " Files Found!"

Ken Puls
10-30-2004, 09:36 PM
I don't want the user to select a map to look in but to make the routine follow a default route to the network. When users start the macrol a form will pop up where the type in the month and the word to search for and then the searching starts. So our network name is \\Disc1\StockData (file:///Disc1StockData). So the routine has to go here. Our data sheets are saved by date every day in the map called by month (e.g. Jan, Feb, etc.).

Meaning that your files are saved in \\Disc1\StockData\Jan (file:///Disc1StockDataJan), \\Disc1\StockData\Feb (file:///Disc1StockDataFeb), etc...?

Are you using a custom userform to capture the data, or did you just want to capture it by using VBA's InputBox function like you use for your search term? (ie, Enter Month:____)

Also, once you have everything working the way you want, make sure you post the entire routine. There's some work that can be done to streamline your code a bit. It may make it run a bit faster, and can definitely be made to be a little easier to follow. In addition, we can remove most of the requirements for the OnError statements (or at least make them a little tighter for you.)

Cheers,

Airborne
10-31-2004, 04:38 AM
Hello Ken, great! The routine you adjusted for counting works. I had to change it a little. I got an error message where you added "Else" telling me "Else without If".
Also (and sorry, I think I wasn't clear enough), I didn't want to receive a message telling me how many files were checked but I wanted a message telling me how many files had hits. So it now looks like this:


Goto NextLoop:
End If
On Error Resume Next 'added
Set MyWS = WB.Sheets("Data")
Test = False 'Check the values in the Text Boxes here
For i = 1 To MyWS.Shapes.Count
boxtext = MyWS.Shapes(i).TextFrame.Characters.Text
If Left(MyWS.Shapes(i).Name, 5) = "Text " Then
If InStr(1, boxtext, search) > 0 Then
Test = True
x = x +1 'count opened files using x as variable




Goto NextLoop
End If
End If
Next

NextLoop:
If Test = False Then
WB.Close False
Set WB = Nothing
Set WS = Nothing
FileName = Dir()
Debug.Print FileName
Loop
msgbox x & " files were found which matched your search term!",vbokonly + vbinformation, x & " Files Found!"


:thumb

To answer the other questions:

Meaning that your files are saved in \\Disc1\StockData\Jan (file:///Disc1StockDataJan), \\Disc1\StockData\Feb (file:///Disc1StockDataFeb), etc...?

As \\Disc1\StockData\Year (file://\Disc1StockDataYear) (2000, 2001, 2002, etc)\Jan, \\Disc1\StockData\Year (file://Disc1/StockData/Year) (2000, 2001, 2002, etc)\Feb, etc.


Are you using a custom userform to capture the data, or did you just want to capture it by using VBA's InputBox function like you use for your search term? (ie, Enter Month:____)

From the standard workbook (Test) where I have a button called search now, I want to use that button to open the UserForm.
Just create a UserForm with two textboxes and an enter/cancel button. You type the year, the month and the word(s) you want to look for then hit the enter button and go.

Also, once you have everything working the way you want, make sure you post the entire routine. There's some work that can be done to streamline your code a bit. It may make it run a bit faster, and can definitely be made to be a little easier to follow. In addition, we can remove most of the requirements for the OnError statements (or at least make them a little tighter for you.)

It would be great if you could make it faster. And sure, I will post the entire routine once it's finished. I think I will have some more wishes along the way ;) but it's getting there.

Regards.

Glaswegian
10-31-2004, 12:23 PM
Hope no-one minds me butting in here. Had a look at your file. To access your textboxes I tested with this

Sub TextboxCheck()
Dim i As Integer
Dim theText As String
For i = 1 To ActiveSheet.TextBoxes.Count
theText = ActiveSheet.TextBoxes(i).Text
MsgBox theText
Next
End Sub

which worked fine (I'm using XP at home). I'm not sure of the search code but you could try the changes I made based on the above test

GoTo NextLoop:
End If
Set MyWS = WB.Sheets("Data")
Test = False
'Check the values in the Text Boxes here
For i = 1 To MyWS.TextBoxes.Count
' Debug.Print MyWS.Shapes(i).Name
BoxText = MyWS.TextBoxes(i).Text
If Left(MyWS.TextBoxes(i).Name, 4) = "Text" Then
If InStr(1, BoxText, Search) > 0 Then
Test = True
GoTo NextLoop
End If
End If
Next


Regards

Airborne
11-01-2004, 06:59 AM
Hello Glaswegian. :yes That also works. I'm not sure which option is better? Or is it just two ways of getting there?

Thanks.

Ken Puls
11-01-2004, 09:30 AM
Nice work Iain!

Airborne, I think I'd use the textboxes method. It's more direct. If there are more than just textboxes in the shapes collection of the workbook, you'll save the time of looping through them all.

For the rest, I'm diving into a month end right now, so don't have too much time free. I'll try to take a look at your next question tonight, if you can hold on. (Unless someone else gets there first!)

Cheers,

Ken Puls
11-01-2004, 11:53 PM
Hey Airbone,

Okay, I've been through your code from start to finish, and made some rather large changes to it. Please don't be offended by this, but I found your code pretty choppy with all the Goto statements, and hard to follow. I had to keep looking back and forward to figure out where one loop ended, another started, if I was in an IF evaluation, etc... Because of that, I've restructured quite a bit. I prefer to build my loops, assign a value to a variable, and then test for it later.

Basically, the differences you'll notice are:

-I've changed your FindAll routine to accept two parameter values: The filepath and the text to search for. This allows you to call it from a textbox, but means you can't just click in the code to run it. In order to step through it, you'll have to set up a routine to pass the variables to it, and step through that one.
-The code is a ton shorter. Passing the variables for the directory from your userform to the FindAll routine means that you don't need the SHGetPathFromIDListA function (API), the BrowseForFolder function, or any of the constants or types associated with them
-I have eliminated all the Goto statements in your code except the "On Error Goto 0" statements. This puts you code into loops that are easier to follow (IMHO) as your code doesn't jump around so much. (Again, IMHO,) It is easier to read as you can test for a condition, then follow it to see where it goes
-I have tightened up your On Error sections to the following format (always best to keep your error handling as tight as possible to avoid catching something you don't want):
On Error Resume Next
'statement which may error out
If Err.number <>0 then
'whatever you want to happen if there WAS an error
End if
On Error Goto 0 'to reset the error value to 0 and to break on unhandled errors
-Used the textboxes object as suggested by Iain (Glaswegian) as it is more direct than looping through the shapes
-I've significantly culled your Dim list to prune out anything no longer required
-I've changed a few of your variable names, mainly for my benefit when testing
-I've commented the routines so that you can follow what I've done (and also because it helped me keep a handle on it!)
-I've written a routine to pass the variables from your userform

Okay, ready? Here goes...

First the FindAll routine, which is to remain in a standard module. I would suggest making a backup copy of your current workbook first, just in case you don't want to go this route. Once that's done, copy this code over all of your old code that you've posted here:

Option Compare Text
Option Explicit
Sub FindAll(SearchPath As String, SearchText As String)
'Macro purpose: Loop through all Excel Workbooks and search each of them for the
'specified criteria
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim TermFound As Boolean
Dim i As Integer, x As Integer
Dim BoxText As String
Dim Problem As Boolean
'Turn off screen flashing
Application.ScreenUpdating = False

'Assign first filename in directory to FileName variable
FileName = Dir(SearchPath & "\*.xls", vbNormal)

Do
'Set problem to false then attempt to open workbook and set WB & WS variables
'(If an error results, set the Problem variable to true)
Problem = False
On Error Resume Next
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
Set WS = WB.Sheets("Data")
If Err.Number <> 0 Then Problem = True
On Error Resume Next

If Problem = True Then
'If an error resulted, (Problem is True,) close the workbook
'(On error resume next in case WB never opened at all)
On Error Resume Next
WB.Close False
On Error GoTo 0

Else
'If no error, check all textboxes in the file for search term
TermFound = False
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = False Then
'If the search term was not found, close the file
WB.Close False
Else
'If the search term was found, add 1 to the count of
'opened files using x as variable to hold the info
x = x + 1
End If
End If
'Release WB & WS variables and set FileName to next file
Set WB = Nothing
Set WS = Nothing
FileName = Dir() 'sets FileName to next file in directory
Loop Until FileName = ""
'Inform the user how many files were opened (number of opend files held in x)
MsgBox x & " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"

'Allow screen updates
Application.ScreenUpdating = True

End Sub

Now, I've made some assumptions regarding your userform, so you may have to adjust some things here. I've assumed the following (using the naming conventions that I use):
-The text box that holds the date is named tbDate, and will ask for a valid date
-The text box that holds the search term is named tbSearch
-Your Okay button's name is cmdOkay
-Your Cancel button's name is cmdCancel
-Your UserForm's name is ufSearch
-August 2004's data would be stored in \\Disc1\StockData\Year2004\Aug\ (file:///Disc1StockDataYear2004Aug)

Given the above, the code that needs to be pasted into the userform object (right click ufSearch and choose "view code") is:
Private Sub cmdOkay_Click()
Const MainPath = "\\Disc1\StockData\Year"
Dim Prompt As String
'Make sure both textboxes have values assigned
If Not IsDate(tbDate.Value) Then Prompt = "Please enter a prompt date" & vbCrLf
If tbSearch.Value = "" Then Prompt = Prompt & "Please enter something to search for"
If Prompt = "" Then
'If Prompt is empty, then no problems were detected, so call the FindAll routine
Call FindAll(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm"), tbSearch.Value)
Unload Me
Else
'If Prompt is not empty, tell the user what info need correcting and return to the
'userform
MsgBox "Sorry, but I need more information!" & vbCrLf & Prompt, _
vbCritical + vbOKOnly, "Hang on!"
End If
End Sub
Private Sub cmdCancel_Click()
'Unload the userform
Unload Me
End Sub

Oh, and if you want the textbox to open with today's date, you could also add (in ufSearch's code pane) the following:
Private Sub UserForm_Initialize()
tbDate.Value = Format(Now(), "mm/dd/yyyy")
End Sub

One thing to be aware of, (although I'm sure you already know,) is that it takes a while to search through each file for your data. During this search, the userform will stay open, but the screen updating is off, so it may end up looking like Excel has hung up. You may want to add a progress bar to the userform to make sure you user's are aware that the program is still working.:yes

I think that's it. I hope this helps, but be sure to post back if something doesn't work.

Now it's off to bed for me! Cheers,

Airborne
11-02-2004, 09:01 AM
Ken:thumb :ipray: etc. You sure did a lot of work, thanks! If you want to learn VBA, this is the forum to go to. The searching sure is faster and it's great that you only have to type the month/year and the word you want to look for. Also cool is the curent date in my form.

Your idea about a progress bar is great but how do I do that:blush ?

Regards.

Zack Barresse
11-02-2004, 09:07 AM
Hi Airborne,

Jake has a good one found here (http://www.vbaexpress.com/kb/getarticle.php?kb_id=169). Here (http://www.cpearson.com/excel/Progress.htm) is another very good one by Chip Pearson (http://www.cpearson.com/excel.htm).

Ken Puls
11-02-2004, 09:46 AM
Hi Airborne,

You're welcome!:)

In addition to the links that Zack posted above, John Walkenback also has one here (http://www.j-walk.com/ss/excel/tips/tip34.htm). It's similar to Chip Pearson's at first glance, but I'm sure that there's some minor differences. I can't say that I have a preference on any of them, as they are all fantastic coders. Read them all, and see which one works best for you. Personally, I think I'd set it up as a multipage control, with the progress indicator on page 2 of the multipage. (Only because I've had good success doing it that way in the past.)

The toughest part that you'll have to cope with is counting all the files in the directory before you start, then updating the progress bar as you go through. I guess we could be set up as a separate function though, returning only the count... Hmm... I'm seeing another KB entry here, as I couldn't find anything in the search. I'll try and work on that tonight, again, if I get some time. (My daughter was really good and went to bed at 8:00 last night! :cool: )

Also, it might be a good idea to add a routine to check if the folder (as determined by your date) exists before the routine fires... just in case it doesn't. That would save the code from bombing in the middle. Nothing worse than a run time error once delivered to the users... Again, a separate utility function could be created for this.:yes

That's it for now. I'll try and check back tonight.:vv

Cheers,

Zack Barresse
11-02-2004, 10:01 AM
What you could do (assuming adaption of Chip Pearsons, although any would do) what you need to do, after registering the .dll file and setting the reference, is put the .Increment property within your loop. As long as you have a start number (1) and an end number (your count) it will/should increment accordingly. Works well for me.

Ken Puls
11-02-2004, 10:11 AM
Thanks Zack.

That looks good. I'll have to play with it tonight. Most likely faster than coding a loop in VBA, and probably a heck of a lot less work than fiddeling with the userform.

Good stuff!

Airborne
11-02-2004, 10:41 AM
Hi Ken and Firefytr. I'm checking out the links and the progress bars all look cool. How to implement them in the routine is not clear to me at the moment:wot .


I hope I don't sound ungrateful but the routine by Chip Pearson is not my first choice. Installing dll files on the network (not on my own pc) will give me extra paperwork I'm afraid.

Thanks and regards.

Ken Puls
11-02-2004, 10:47 AM
Ungrateful? :rofl

I think that's a pretty valid concern (the installation part, not the ungrateful part!) If it's going to get you in trouble with the IT guys, it's probably a problem!

Let's go back to the userform method. Check out DRJ's and J-Walk's methods, as they both use a userform, and no intallations on networks are required.

Cheers,

Ken Puls
11-02-2004, 11:11 PM
Okay, just to be difficult, I opted on an easier method than all the progress indicators. I only had a couple of minutes tonight, and it's way quicker to go this route. To use the progress indicator, the code should really be broken up a bit, so that it can be called in chunks from the userform. I say this because the trigger point to update the file count is in the middle of the block.

I don't have the time to go that route, so I've settled on updating the StatusBar in the bottom left hand corner of the Excel screen instead. (Where it probably says "Ready" right now.) It still gives progress, but unfortunately isn't as noticeable as the full on progress indicators we talked about earlier. I'm still willing to give those a shot, but let's try this first and see if it works (and is acceptable) for you.

I've also added two functions, which go in the standard module with the findall routine. One is to check if the directory exists, before jumping into the FindAll code, and the other is to count the number of files in the directory to measure our progress. One caveat about that one, though... it counts all files, so can give incorrect results if you have non-excel files. I had 4 files, 1 a zip file, so it ran up to 75% complete, and then finished. It didn't get to 100%, as the routine only actually opens Excel files. (The code still completes, it just looks like it's done prematurely.)

So here's all the new code:

STANDARD MODULE:
Option Compare Text
Option Explicit
Function FolderExists(Folder As String) As Boolean
'Function purpose: To count all files in a directory
Dim fso As Object, _
SubFolder As Object

'Create objects to get a count of files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set SubFolder = fso.GetFolder(Folder).Files
If Err.Number <> 0 Then
FolderExists = False
Else
FolderExists = True
End If
On Error GoTo 0
End Function
Function CountFiles(Directory As String) As Double
'Function purpose: To count all files in a directory
Dim fso As Object, _
SubFolder As Object

'Create objects to get a count of files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set SubFolder = fso.GetFolder(Directory).Files
If Err.Number <> 0 Then
CountFiles = 0
Else
CountFiles = SubFolder.Count
End If
On Error GoTo 0
End Function
Sub FindAll(SearchPath As String, SearchText As String)
'Macro purpose: Loop through all Excel Workbooks and search each of them for the
'specified criteria
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim TermFound As Boolean
Dim i As Integer, x As Integer
Dim Processed As Integer, ToProcess As Integer
Dim BoxText As String
Dim Problem As Boolean
'Turn off screen flashing
Application.ScreenUpdating = False

'Count number of files to proces, and assign first filename in directory to
'FileName variable
ToProcess = CountFiles(SearchPath)
FileName = Dir(SearchPath & "\*.xls", vbNormal)

Do
'Inform the user how many files have been processed
Processed = Processed + 1
Application.StatusBar = "Processing file " & Processed & " of " & _
ToProcess & " (" & Int(Processed / ToProcess * 100) & "% complete)"

'Set problem to false then attempt to open workbook and set WB & WS variables
'(If an error results, set the Problem variable to true)
Problem = False
On Error Resume Next
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
Set WS = WB.Sheets("Data")
If Err.Number <> 0 Then Problem = True
On Error Resume Next

If Problem = True Then
'If an error resulted, (Problem is True,) close the workbook
'(On error resume next in case WB never opened at all)
On Error Resume Next
WB.Close False
On Error GoTo 0

Else
'If no error, check all textboxes in the file for search term
TermFound = False
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = False Then
'If the search term was not found, close the file
WB.Close False
Else
'If the search term was found, add 1 to the count of
'opened files using x as variable to hold the info
x = x + 1
End If
End If
'Release WB & WS variables and set FileName to next file
Set WB = Nothing
Set WS = Nothing
FileName = Dir() 'sets FileName to next file in directory
Loop Until FileName = ""

'Inform the user how many files were opened (number of opend files held in x)
MsgBox x & " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"

'Restore screen updating and clear statusbar
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

USERFORM CODE:
Option Explicit
Private Sub cmdOkay_Click()
Const MainPath = "\\Disc1\StockData\Year"
Dim Prompt As String
'Make sure both textboxes have values assigned
If Not IsDate(tbDate.Value) Then Prompt = "Please enter a prompt date" & vbCrLf
If tbSearch.Value = "" Then Prompt = Prompt & "Please enter something to search for"
If Prompt = "" Then
'If Prompt is empty, then no problems were detected
If FolderExists(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")) Then
'If the folder for the month exists call the FindAll routine
Call FindAll(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm"), tbSearch.Value)
Unload Me
Else
'If the folder for the month does not exist, notify the user
MsgBox "The information you entered generated a file path of:" & vbCrLf & _
MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & vbCrLf & vbCrLf & _
"That file path does not exist! Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Folder does not exist!"
End If
Else
'If Prompt is not empty, tell the user what info need correcting and return to the
'userform
MsgBox "Sorry, but I need more information!" & vbCrLf & Prompt, _
vbCritical + vbOKOnly, "Hang on!"
End If
End Sub
Private Sub cmdCancel_Click()
'Unload the userform
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Put today's date in the userform
tbDate.Value = Format(Now(), "mm/dd/yyyy")
End Sub

Let me know how that works, and if you'd rather go the full progress indicator.

Cheers,

Airborne
11-03-2004, 04:14 AM
:thumb Great Ken, thanks. It works. You are right that it's not as noticeable as the other bars but it works fine for me (if you can find a way though to get one of the cool bars in the routine I won't say no:blush:giggle ).

The error messages are great. It tells you the route where you went wrong. I've tried to create errors and I now only get an error when the map it searches in is empty. The rest of the errors are covered.

The other thing is, the search is always in the "Data" sheet. Today I got the idea that it would also be nice if I could search the "stock" sheet which is in the same workbook. In here we have two textboxes too. I've tried Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
Set WS = WB.Sheets("Data")
Set WS = WB.Sheets("Stock")
If Err.Number <> 0 Then Problem = True
On Error Resume Next
But that's not to smart because it then only searches through the "Stock" sheets.

Thanks again for all the trouble,

Regards.

Ken Puls
11-03-2004, 09:49 AM
Hi Airborne,

I'll try to look at the progress bar again tonight. I have been thinking on it, and it may not be a difficult as I thought. Give me a bit more time to mull it over. :115:

As for the rest:

I've tried to create errors and I now only get an error when the map it searches in is empty.
This should take care of that error. Replace all the code in the cmdOkay_Click routine in the userform, (after the dim prompt statement) with this:
'Make sure both textboxes have values assigned
If Not IsDate(tbDate.Value) Then Prompt = "Please enter a prompt date" & vbCrLf
If tbSearch.Value = "" Then Prompt = Prompt & "Please enter something to search for"
If Prompt = "" Then
'If Prompt is empty, then no problems were detected
If FolderExists(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")) Then
If CountFiles(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")) > 0 Then
'If folder for the month exists & has files in it, call FindAll routine
Call FindAll(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm"), _
tbSearch.Value)
Unload Me
Else
'If no files are in the directory, inform the user
MsgBox "The information you entered generated a file path of:" & _
vbCrLf & MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & _
vbCrLf & vbCrLf & "There are no files in that directory!" & vbCrLf & _
"Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Directory is empty!"
End If
Else
'If the folder for the month does not exist, notify the user
MsgBox "The information you entered generated a file path of:" & vbCrLf & _
MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & vbCrLf & vbCrLf & _
"That file path does not exist! Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Folder does not exist!"
End If
Else
'If Prompt is not empty, tell the user what info need correcting and return to the
'userform
MsgBox "Sorry, but I need more information!" & vbCrLf & Prompt, _
vbCritical + vbOKOnly, "Hang on!"
End If


The other thing is, the search is always in the "Data" sheet. Today I got the idea that it would also be nice if I could search the "stock" sheet which is in the same workbook. In here we have two textboxes too.
I've changed the FindAll routine so avoid setting WS to a specific worksheet, and instead set it up to loop through all worksheets in the workbook. It will exit (leaving the workbook open) the first time it finds a match in a textbox on any sheet.

To do this, gong both the set WS lines in the following:
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
'\\\delete this line! Set WS = WB.Sheets("Data")
'\\\delete this line! Set WS = WB.Sheets("Stock")
If Err.Number <> 0 Then Problem = True
On Error Resume Next

And wrap the contents of the Else section of the Do Loop with the For Each WS loop:
For Each WS In WB.Worksheets
'If no error, check all textboxes in the file for search term
TermFound = False
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = False Then
'If the search term was not found, close the file
WB.Close False
Else
'If the search term was found, add 1 to the count of
'opened files using x as variable to hold the info
x = x + 1
Exit For
End If
Next WS

Hope that all makes sense, but post back if not. (Or if you think of anything else! :) )

Cheers,

Airborne
11-03-2004, 11:17 AM
Hello Ken, I get the message "Ambigous name detected:FolderExists" in line "If FolderExists(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")) Then". It pops up right after I click [OK] on the form (date and text to search for is filled in):eek:.


Regards.

Ken Puls
11-03-2004, 11:23 AM
Doh!

If memory servers, that usually happens because you have two routines with exactly the same name.

Can you check your workbook to see if the routine exists twice (maybe in two separate modules). If not, try any other open workbooks.

Let me know,

Airborne
11-03-2004, 11:38 AM
:blush :ipray: sorry, sorry Ken. I was to quick to reply and you were to quick to answer. I kept the old code in the workbook and put your modifications in an new module but forgot to change the names, double names!

I've changed the names of the "old" module. I've tried to make all the errors and it's realy fantastic how they are handled in your modified routine. GREAT!

Thanks and regards.

Ken Puls
11-03-2004, 11:42 AM
Shoot!

Just found out that VBA has a native FolderExists method. Nothing like re-inventing the wheel! :roll: :D

I don't think that would be the issue though, as we've been using that code for a bit, and it hasn't errored out. In addition, I went into the file I've been using and commented out the entire FolderExists function I wrote, and the code won't run. (Not calling the native version correctly.)

I'm pretty sure you must have a second copy of the function kicking around in your WB somewhere.

Having said that, I'll try and look at that code tonight as well. There's no point in using a User Defined Function if a native one exists, as the native ones are always faster.

Ken Puls
11-03-2004, 11:52 AM
I was to quick to reply and you were to quick to answer
Looks like there might be another case of that just happened from my side!
:D

Airborne
11-03-2004, 12:49 PM
Ken, I've tried the routine by puting some text in the textbox of the stock sheet but it doesn't see any text. The Data sheet is always the first sheet you see when the workbook opens. It finds everything I ask for in the data sheet but it ignores the stock sheet.
:blush And sorry that I was not clear enough but in the monthly maps are also some timesheets with only the sheet named Time in them but I don't want the routine to open those files. I guess you must be getting a bit tired of my replies:p .

Regards.

Ken Puls
11-03-2004, 04:07 PM
Hi there,

It shouldn't matter if the Data sheet is first, or not, as the code is set up to go through each sheet in the file, then each textbox on the sheet.

I need to ask a couple of stupid questions...
-Are you certain that the textboxes were set up exactly the same as the other ones?
-You're sure the search term is in the box on the Stock sheet (sorry, I had to ask!)
-Can you upload a new copy of a target file that has textboxes you're using on both pages? The one I downloaded doesn't have any textboxes on the Stock page. (Pull out any confidential data first though.)

With regards to the timesheet files, they would actually have been opened with the old macro, then closed immediately when it couldn't find the Data sheet. This version will take slightly longer as it looks through the sheet for textboxes, and then closes it. Is there a standard naming convention to the time sheet files? If there is, we can prevent it from opening them at all.

And not at all tired, by the way! If you can stay patient, I'm enjoying helping out. It hasn't been that long since I was in the same boat!:yes

Airborne
11-04-2004, 02:39 AM
Hi Ken. I'm very patient. I learn a bit of VBA every day and my workbook gets better every day. What more do I want:giggle .


About your questions:
I need to ask a couple of stupid questions...
-Are you certain that the textboxes were set up exactly the same as the other ones?
Yes, I'll send you a new copy.

-You're sure the search term is in the box on the Stock sheet (sorry, I had to ask!)
Yes I put some comments in it but it wasn't found by the search routine.

-Can you upload a new copy of a target file that has textboxes you're using on both pages? The one I downloaded doesn't have any textboxes on the Stock page. (Pull out any confidential data first though.)
See att.

And you are right, there are no textboxes in the timesheet so it doesn't matter.

Thanks and regards.

Airborne
11-04-2004, 02:44 AM
Sorry forgot the attachment:eek:

johnske
11-04-2004, 03:54 AM
While you're looking at progress bars, check out Stephen Bullens WksPrgrs.zip at this link >> http://bmsltd.ie/Excel/SBXLPage.asp

Airborne
11-04-2004, 04:01 AM
Thanks jonske. Not only nice to look for bars, the site is filled with great VBA stuff.

Regards.

Ken Puls
11-04-2004, 11:41 AM
Hi Airborne,

Sorry, got deadlines today, and ran into systems issues at home last night. I'll try to get back this afternoon if I can free up some time....

EDIT...

Never mind. Took a quick look and saw the issue.

Try this out:

Sub FindAll(SearchPath As String, SearchText As String)
'Macro purpose: Loop through all Excel Workbooks and search each of them for the
'specified criteria
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim TermFound As Boolean
Dim i As Integer, x As Integer
Dim Processed As Integer, ToProcess As Integer
Dim BoxText As String
Dim Problem As Boolean
'Turn off screen flashing
Application.ScreenUpdating = False

'Count number of files to proces, and assign first filename in directory to
'FileName variable
ToProcess = CountFiles(SearchPath)
FileName = Dir(SearchPath & "\*.xls", vbNormal)

Do
'Inform the user how many files have been processed
Processed = Processed + 1
Application.StatusBar = "Processing file " & Processed & " of " & _
ToProcess & " (" & Int(Processed / ToProcess * 100) & "% complete)"

'Set problem to false then attempt to open workbook and set WB & WS variables
'(If an error results, set the Problem variable to true)
Problem = False
On Error Resume Next
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
If Err.Number <> 0 Then Problem = True
On Error Resume Next

If Problem = True Then
'If an error resulted, (Problem is True,) close the workbook
'(On error resume next in case WB never opened at all)
On Error Resume Next
WB.Close False
On Error GoTo 0

Else
TermFound = False
For Each WS In WB.Worksheets
'If no error, check all textboxes in the file for search term
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = True Then Exit For
Next WS
If TermFound = False Then
'If the search term was not found, close the file
WB.Close False
Else
'If the search term was found, add 1 to the count of
'opened files using x as variable to hold the info
x = x + 1
End If
End If
'Release WB & WS variables and set FileName to next file
Set WB = Nothing
Set WS = Nothing
FileName = Dir() 'sets FileName to next file in directory
Loop Until FileName = ""

'Inform the user how many files were opened (number of opend files held in x)
MsgBox x & " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"

'Restore screen updating and clear statusbar
Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Will look at rest of stuff later! Gotta run...

Cheers,

Airborne
11-04-2004, 04:35 PM
:thumb Hi Ken, even though you were in a hurry, you solved it so now it checks the text in both sheets. Great!

It's getting almost perfect now. The only thing is that the screen keeps flickering. At first you could also see the files opening/closing in the taskbar but I added Application.ShowWindowsInTaskbar = False and at the end Application.ShowWindowsInTaskbar = True So the sheets with the hits can only be seen at the end of the routine.
Now It would be great if the original sheet would stay in focus and that the opening/closing of the searched sheets would stay in the background. Don't know if that's possible. But now you see every checked sheet opening and closing. I've tried to put Application.ScreenUpdating = False, but in the end it was all over the routine and the flickering kept on going.:eek:

I don't know if the next question should come in a new thread.......do you know a routine that gives a message when people click on the upper right [X] of Excel to tell them to close by clicking on a button in the sheet? So closing by clicking [X] is not possible in this workbook only.:wot


Thanks and regards.

mdmackillop
11-04-2004, 04:40 PM
Hi Airborne
Ken's done all the hard work so.....

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Cancel = True
MsgBox "Please close by using the button"
End Sub

Airborne
11-04-2004, 04:56 PM
:thumb Great mdmackillop, thanks for the quick reply. Works!

Regards.

mdmackillop
11-04-2004, 04:58 PM
I like the easy bits! :yes :yes :yes

Airborne
11-04-2004, 05:04 PM
Sorry. I think I've done something wrong. I thought it worked because when I click on the button It doesn't close and I get a message to close using ....button. But it now is impossible to close the file. :eek: :mkay


Regards.

Ken Puls
11-04-2004, 05:10 PM
Airborne... I tried adding the .showwindowsintaskbar (never used that before!) and it seems to work just the way you're looking for in my case...

In the Findall routine, I changed:
'Turn off screen flashing
Application.ScreenUpdating = False
To
'Turn off screen flashing & taskbar updates
With Application
.ScreenUpdating = False
.ShowWindowsInTaskbar = False
End With

And near the end:
'Restore screen updating and clear statusbar
Application.ScreenUpdating = True
Application.StatusBar = False
To
'Restore screen updating, show open files on taskbar and clear statusbar
With Application
.ScreenUpdating = True
.StatusBar = False
.ShowWindowsInTaskbar = True
End With

No screen flashing, no taskbar updates until you click okay. Is that what you meant?

mdmackillop
11-04-2004, 05:17 PM
Same here!!!!

Ken Puls
11-04-2004, 05:17 PM
Sorry. I think I've done something wrong. I thought it worked because when I click on the button It doesn't close and I get a message to close using ....button. But it now is impossible to close the file. :eek: :mkay :rofl That's what you wanted, isn't it? :rofl

I think MD's idea was that you used a separate command button to close the file. If you comment the code, though, you'll be able to continue until that's confirmed...

MD, I think that method will only work for a userform... but could be wrong...

mdmackillop
11-04-2004, 05:27 PM
Hi, I think you need the following code in your button. I'm not totally clear as to any knock-on effects on other open Excel files though.
MD
Application.EnableEvents = False
ActiveWorkbook.Close





I hate it when my computer does what I tell it to, and not what I want it to.

Airborne
11-04-2004, 05:34 PM
:ipray: Ken I guess you did it again. Fantastic! Now it looks real professional:cool . A real search engine in my workbook!

I hope you won't be offended but I never thought this project would become this professional so I would like to speed up the search (search on a map of 90 files takes 1 minute vs Windows search 25 seconds) and add a search bar as Windows uses in it's search engine.:blush

Do you want me to put the routines you made with comments in this thread now?

Thanks and regards.

Ken Puls
11-04-2004, 05:49 PM
Hmmm...

First, for the record, I stand corrected on the close routine. Thanks MD!

Second... ho boy! My only concern here is that I don't know how much faster we can make it. Remember that Windows is specifically built for this kind of function, while VBA calls some of those and runs them. Inherently, they will always be slower. I'll pitch in what I can though, but be aware that it may be small improvements, not large. (I'm always game for a challenge though! :yes )

FYI, you never answered me on the time sheet naming... if there is a convention, we could save the time of opening those files by evaluating their name before we open them. That would save on the open/close time for each of those, at least.

As for the progress bar, yep, we can do that. Out of curiosity, can you export a copy of your userform (right click it in the VBA explorer), zip it up and post it here? I want to see how it's set up to tinker with it. I read a bit about it last night before bed (my wife reads novels, if you can believe that! :roll: ), and came up with a good one, I think. I should be able to make it without slowing down your code much at all, as it could just replace the statusbar part.

Maybe do post the full FindAll routine, though. If the userform hasn't changed, that should be okay.

Cheers,

Airborne
11-04-2004, 06:16 PM
:yes Hi mdmackillop, that works. I added the line Application.EnableEvents = False (as you said) to my quit routine. That routine has knock-on effects on other sheets unfortunately. I'm working on that still. Sub Quit()Application.EnableEvents = False
If MsgBox("Close Data tool Without Saving Other Excel Files?", _
vbQuestion + vbYesNo) = vbYes Then
Application.ScreenUpdating = False
Application.Quit
Workbooks("Data1").Close saveChanges:=False
ActiveWorkbook.Close saveChanges:=False
Else
End
End If

End Sub I would like the routine to check if other workbooks are open and then ask the question as above in the msgbox, otherwise it should close right away.

But maybe I should transfer this to another thread. Ken works on this thread while his wife reads novels but my wife is already sleeping:bawl . I'll answer him and then it's off to bed.

Thanks and regards. vbmenu_register("postmenu_10634", true);

mdmackillop
11-04-2004, 06:17 PM
Hi both,
I've not been following the detail closely, but if this search is to be used routinely, here's a few thoughts

A variation could be to save the positive results for the commonly used search terms in a specific worksheet within each workbook (maybe a WorkbookClose routine). You could then search only these worksheets for the desired files.
Ideally, you would want a solution which can be searched without opening the workbooks.
http://www.experts-exchange.com/Applications/MS_Office/Excel/Q_20980429.html

Another idea would be to add the search terms, either as Keywords or Custom Fields to the WorkBook properties.

Finally, you could write the results to an "index" file to maintain a record of the file locations.

MD

Airborne
11-04-2004, 06:23 PM
Hi Ken, here are both routines. The form is still as you said.Private Sub cmdOkay_Click()
Const MainPath = "\\Disk1\Stockdata\Year\ (file://\Disk1StockdataYear)"
Dim Prompt As String
'Make sure both textboxes have values assigned
If Not IsDate(tbDate.Value) Then Prompt = "Please enter a prompt date" & vbCrLf
If tbSearch.Value = "" Then Prompt = Prompt & "Please enter something to search for"
If Prompt = "" Then
'If Prompt is empty, then no problems were detected
If FolderExists(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")) Then
If CountFiles(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")) > 0 Then
'If folder for the month exists & has files in it, call FindAll routine

Unload Me

Call FindAll(MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm"), _
tbSearch.Value)

Else
'If no files are in the directory, inform the user
MsgBox "The information you entered generated a file path of:" & _
vbCrLf & MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & _
vbCrLf & vbCrLf & "There are no files in that directory!" & vbCrLf & _
"Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Directory is empty!"
End If
Else
'If the folder for the month does not exist, notify the user
MsgBox "The information you entered generated a file path of:" & vbCrLf & _
MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & vbCrLf & vbCrLf & _
"That file path does not exist! Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Folder does not exist!"
End If
Else
'If Prompt is not empty, tell the user what info need correcting and return to the
'userform
MsgBox "Sorry, but I need more information!" & vbCrLf & Prompt, _
vbCritical + vbOKOnly, "Hang on!"
End If

End Sub
Private Sub cmdCancel_Click()
'Unload the userform
Unload Me
End Sub

Private Sub UserForm_Initialize()
'Put today's date in the userform
tbDateToday.Value = Format(Now(), "d-mmm-yyyy")
End Sub



And......Option Compare Text
Option Explicit
Function FolderExists(Folder As String) As Boolean
'Function purpose: To count all files in a directory
Dim fso As Object, _
SubFolder As Object

'Create objects to get a count of files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set SubFolder = fso.GetFolder(Folder).Files
If Err.Number <> 0 Then
FolderExists = False
Else
FolderExists = True
End If
On Error GoTo 0
End Function
Function CountFiles(Directory As String) As Double
'Function purpose: To count all files in a directory
Dim fso As Object, _
SubFolder As Object

'Create objects to get a count of files in the directory
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set SubFolder = fso.GetFolder(Directory).Files
If Err.Number <> 0 Then
CountFiles = 0
Else
CountFiles = SubFolder.Count
End If
On Error GoTo 0
End Function
Sub FindAll(SearchPath As String, SearchText As String)
'Macro purpose: Loop through all Excel Workbooks and search each of them for the
'specified criteria
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim TermFound As Boolean
Dim i As Integer, x As Integer
Dim Processed As Integer, ToProcess As Integer
Dim BoxText As String
Dim Problem As Boolean
'Turn off screen flashing
With Application
.ScreenUpdating = False
.ShowWindowsInTaskbar = False
End With
'Count number of files to proces, and assign first filename in directory to
'FileName variable
ToProcess = CountFiles(SearchPath)
FileName = Dir(SearchPath & "\*.xls", vbNormal)

Do
'Inform the user how many files have been processed
Processed = Processed + 1
Application.StatusBar = "Processing file " & Processed & " of " & _
ToProcess & " (" & Int(Processed / ToProcess * 100) & "% complete)"

'Set problem to false then attempt to open workbook and set WB & WS variables
'(If an error results, set the Problem variable to true)
Problem = False
On Error Resume Next
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
If Err.Number <> 0 Then Problem = True
On Error Resume Next

If Problem = True Then
'If an error resulted, (Problem is True,) close the workbook
'(On error resume next in case WB never opened at all)
On Error Resume Next
WB.Close False
On Error GoTo 0

Else
TermFound = False
For Each WS In WB.Worksheets
'If no error, check all textboxes in the file for search term
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = True Then Exit For
Next WS
If TermFound = False Then
'If the search term was not found, close the file
WB.Close False
Else
'If the search term was found, add 1 to the count of
'opened files using x as variable to hold the info
x = x + 1
End If
End If
'Release WB & WS variables and set FileName to next file
Set WB = Nothing
Set WS = Nothing
FileName = Dir() 'sets FileName to next file in directory
Loop Until FileName = ""

'Inform the user how many files were opened (number of opend files held in x)
MsgBox x & " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"

'Restore screen updating and clear statusbar
' Application.ScreenUpdating = True
' Application.DisplayStatusBar = False
' Application.ShowWindowsInTaskbar = True
With Application
.ScreenUpdating = True
.StatusBar = False
.ShowWindowsInTaskbar = True
End With
End Sub




Regards.

Ken Puls
11-04-2004, 11:21 PM
Okay... here we go!

I've rewritten a bunch to get the progress bar working, so you'll want to review this carefully. Some things to note:
-You no longer need the "FolderExists" or "CountFiles" functions, as I have rolled them both into the cmdOkay routine of the userform
-In addition, the count of the files now is passed to the FindAll routine so that it doesn't need to be recalculated
-The progress indicator has replaced the statusbar, but it most likely will slow things down a bit. At least you get to watch something though, I guess ;) It is 4-5 lines of code instead of 1, which gives rise to the speed concern, but hopefully it isn't too much
-The userform now expands and shrinks to show/hide the progress indicator
-I've attached a zipped copy of the userform that I've been working with as I think it's easier that way than trying to explain it. If your userform is called ufSearch, you will want to rename it before you attempt to import this one
-I have not done much to the file searching at this point. That is going to take a little while to read up on around the net (thanks for the posts, MD, those will be helpful). I figured that speed could probably come later, as long as the main view is there first. (Again, at least giving your users something to watch while the wait:) )


So here's all the code... In the regular module:
Option Compare Text
Option Explicit
Sub FindAll(SearchPath As String, SearchText As String, ToProcess As Integer)
'Macro purpose: Loop through all Excel Workbooks and search each of them for the
'specified criteria
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim TermFound As Boolean
Dim i As Integer, x As Integer
Dim Processed As Integer
Dim BoxText As String
Dim Problem As Boolean

'Turn off screen flashing & taskbar updates
With Application
.ScreenUpdating = False
.ShowWindowsInTaskbar = False
End With

'Assign first filename in directory to FileName variable
FileName = Dir(SearchPath & "\*.xls", vbNormal)

'Expand ufSearch to show progress bar
With ufSearch
.Height = 174
.Repaint
End With

Do
'Set problem to false then attempt to open workbook and set WB & WS variables
'(If an error results, set the Problem variable to true)
Problem = False
On Error Resume Next
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
If Err.Number <> 0 Then Problem = True
On Error Resume Next

If Problem = True Then
'If an error resulted, (Problem is True,) close the workbook
'(On error resume next in case WB never opened at all)
On Error Resume Next
WB.Close False
On Error GoTo 0

Else
TermFound = False
For Each WS In WB.Worksheets
'If no error, check all textboxes in the file for search term
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = True Then Exit For
Next WS
If TermFound = False Then
'If the search term was not found, close the file
WB.Close False
Else
'If the search term was found, add 1 to the count of
'opened files using x as variable to hold the info
x = x + 1
End If
End If

'Inform the user how many files have been processed and update the progress bar
Processed = Processed + 1
Call UpdateProgress(Processed / ToProcess)

'Release WB & WS variables and set FileName to next file
Set WB = Nothing
Set WS = Nothing
FileName = Dir() 'sets FileName to next file in directory
Loop Until FileName = ""

'Restore screen updating, show open files on taskbar and clear statusbar
With Application
.ScreenUpdating = True
.ShowWindowsInTaskbar = True
End With

'Hide the progress indicator
With ufSearch
.Hide
End With

'Inform the user how many files were opened (number of opend files held in x)
MsgBox x & " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"

End Sub
Sub UpdateProgress(PctDone As Single)
'Source: John Walkenbach's Excel 2002 Power Programming with VBA
'Purpose: To update the ufSearch userform
With ufSearch
.frmProgress.Caption = Format(PctDone, "0%")
.lblProgress.Width = PctDone * (.frmProgress.Width - 10)
.Repaint
End With
End Sub

And in the userform:
Option Explicit
Private Sub cmdOkay_Click()
Const MainPath = "\\Disk1\Stockdata\Year\ (file:///Disk1StockdataYear)"
Dim Prompt As String, _
FilesToProcess As Integer, _
fso As Object, _
FullFilePath As String
'Make sure both textboxes have values assigned
If Not IsDate(tbDate.Value) Then Prompt = "Please enter a prompt date" & vbCrLf
If tbSearch.Value = "" Then Prompt = Prompt & "Please enter something to search for"

'If Prompt is empty, then no problems were detected
If Prompt = "" Then
'Create a file scripting object and set the FullFilePath variable
Set fso = CreateObject("Scripting.FileSystemObject")
FullFilePath = MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm")

'Check if the file path exists, and count the number of files in it
If fso.FolderExists(FullFilePath) Then
FilesToProcess = fso.GetFolder(FullFilePath).Files.Count
If FilesToProcess > 0 Then
'If folder for the month exists & has files in it, call FindAll routine
Call FindAll(FullFilePath, tbSearch.Value, FilesToProcess)
Unload Me
Else
'If no files are in the directory, inform the user
MsgBox "The information you entered generated a file path of:" & _
vbCrLf & MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & _
vbCrLf & vbCrLf & "There are no files in that directory!" & vbCrLf & _
"Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Directory is empty!"
End If
Else
'If the folder for the month does not exist, notify the user
MsgBox "The information you entered generated a file path of:" & vbCrLf & _
MainPath & Year(tbDate) & "\" & Format(tbDate, "mmm") & vbCrLf & vbCrLf & _
"That file path does not exist! Please modify your selection and try again!", _
vbOKOnly + vbCritical, "Folder does not exist!"
End If
Else
'If Prompt is not empty, tell the user what info need correcting and return to the
'userform
MsgBox "Sorry, but I need more information!" & vbCrLf & Prompt, _
vbCritical + vbOKOnly, "Hang on!"
End If
End Sub
Private Sub cmdCancel_Click()
'Unload the userform
Unload Me
End Sub
Private Sub UserForm_Initialize()
'Shrink userform so progress bar doesn't show
Me.Height = 108
'Put today's date in the userform
tbDate.Value = Format(Now(), "d-mmm-yyyy")
End Sub

To import the attached, right click on your forms directory and choose "import" (but remember to change your userform first if it's name is ufSearch!)

Now it's time for me to go :snooze too!

:hi:

Airborne
11-05-2004, 02:15 AM
Ken:thumb :dance: :ipray: :super: that's it, FANTASTIC! I had a good short night sleep but I couldn't wait how fast to check my e-mail.

I don't know if you agree but I guess this thread is solved. I'll wait for your comments because of the recommendations of mdmackillop (thanks) before I mark it solved.

I will post the other questions regarding my workbook in a new thread because they have nothing to do with the search engine.

Thanks very much for your trouble (you will have some time to read a novel too now:wot ;) ).

Regards.

Ken Puls
11-05-2004, 09:52 AM
Hi Airborne.

Glad it works! As far as marking the thread solved, that's your call, not mine. :yes Is it doing everything you want it to? How is the speed factor (did the most recent changes make a difference one way or another?)

I've mulled over MD's comments, and they hinge on two important points:
-Will you be able to come up with a list of the most frequently used search tems?
-What happens if a user wants to search for a term that isn't in your list?

I've read a few articles on trying to pull from a closed workbook as well (thanks to some referenced articles in the link MD posted, and at Ozgrid.) The one issue I can see here, from everythign I've read, is that it all points to pulling from worksheet cells, not textboxes. I don't know how easy it would be to get around that, as the textbox objects may not be supported with those methods.:dunno

And I'm glad to have been of help with it too. (And FYI, I read Excel books instead of novel's on a regular basis. I actually enjoy it!:p )

Cheers! :cool:

mdmackillop
11-05-2004, 10:20 AM
Hi Ken,
I wasn't thinking to read textboxes from a closed workbooks, but rather an "index" page within the workbook.
Thanks for "taking over" this one as I've been busy with a query elsewhere.
MD

Ken Puls
11-05-2004, 10:41 AM
Hi MD, as I said, quite enjoyed it. I love working on projects where you can follow it along from start to finish. Gives a good sense of accomplishment at the end of the day.

With regards to the search, let me see if I've finally understood you.. (;) ).

You're thinking of something like writing all textbox values to a specific sheet (one of more cells) before closing. Then using one of the aformentioned procedures to search those cell(s), on that specific sheet only, without opening the workbook?

I think that could be made to work. :yes I'm thinking I'd put it in the same workbook, or you could run into issues with maintaining (syncronizing) the files. Of course, knowing the amount of data typically (and the max amount) entered in the TextBox would be important to determine the best way to structure it in a the sheet.

Is that sort of what you meant?

mdmackillop
11-05-2004, 12:00 PM
Ki Ken,

That's the general idea. If there is a list of commonly used search terms, this could be set up as a Close event, to keep the data in the book (or separate index) up to date, and your routine, as you have it at present, would always be available for custom searches.

MD

Ken Puls
11-05-2004, 12:12 PM
All right, I'm game for that!

So Airborne... what do you think? Would you like to try on this one? One caveat... I'm away this weekend, so it will take me a little time to respond on it initially.

Would need a couple of things from you to proceed though...

-The workbook that fires your search procedure... can we store an index on a sheet in it, or does would you prefer it to be stored in a different workbook?

-Can you provide a list of the most frequently used search terms?

Airborne
11-05-2004, 01:55 PM
Hi both,
Sorry for replying that late but work, work......

First: It worked great from home, it worked great on a stand-alone pc at work (not supported by IT) but on the pc's supported by IT the sheet where the bar is on, disappears (the bar stays) and you see all the files that are beeing searched popping up and closing again. After 90 files opening and closing fast you get a little nervous. Now the IT guys had already left for the weekend so I couldn't ask one of them. The configuration of Excel is the same on all pc's, so I'm a bit confused:wot .

The idea of not opening sheets sounds nice all of a sudden. We work from the standard sheet, all the macro's are there, so storing an index there is no problem. We don't realy need a search history and when you get the message no files found that matched your criteria is fine by me. The sarch criteria are very mixed. Sometimes we search on a tagnumber and then on a person, then on equipment name, it's very difficult to give a list.

I was very happy with the routines you provided and I'm a bit :bawl that I have the problem on the IT pc's.

I'm sure willing to try the new idea though, everything I can do to learn VBA is fine by me:thumb

Ken Puls
11-05-2004, 04:23 PM
Airborne,

I'm a little stumped as to why it wouldn't work on the IT pc's too. If all the configurations are the same, and you're using the most up to date file, that doesn't really make sense to me. Are all the same add-ins installed?

And now for something completely different... If you don't have commonly used search terms, it puts a wrinkle in that plan, but what about this...

You only have 8 textboxes in a file, right? So if you dumped the entire contents of your textbox into a cell (8 columns, 1 for each textbox), and also the file path and name (in another 2), using the workbook_beforesave event (in the tb laden files)...

You should then have a master list of all contents of all textboxes in all files with their paths. Theoretically, you should be able to search using the find method on the worksheet list, and if the term shows up in any of the columns, add the file path to an array. Once you have the array, open up each file in it.

I would think it would be way faster than opening, checking, closing, etc...

Just a thought. What do you guys think?

Airborne
11-05-2004, 05:46 PM
Hi Ken, it's not that it doesn't work. The search engine works great! It will find every word I search for. But, it's the flickering of the screen, files opening/closing for about one minute. I don't know why it happens on the IT pc's. All the add-ins are installed. It looks so professionel on my pc:bawl .

As for your suggestion:wot....that's too much English for me:blush . Can you give me an example?

Thanks and regards.

p.s.
:snoozeIt's that time already at my location.

Ken Puls
11-05-2004, 05:53 PM
Sorry, Airborne. I knew what you meant, but it's like the screenupdating code isn't firing. Why that would be, I just don't know.

As far as the rest goes, why don't I post some stuff up on Monday (maybe Sunday if I get a chance.) Stuff to do tonight, and off on a trip tomorrow for the weekend.

Have a good weekend!

mdmackillop
11-05-2004, 05:57 PM
Hi Airborne,
I've been playing around with an Index solution and come up with the following
This code has to be inserted in each of your workbooks
Option Explicit
Option Base 1

Sub GetBoxText()
Dim MyWS As Worksheet

Dim BoxText()
Dim i!, j!

'If no Data sheet then exit sub
Sheets("Data").Select
If Err <> 0 Then Exit Sub

'Create FindWord sheet if it does not exist
On Error Resume Next
Sheets("FindWord").Select
If Err <> 0 Then
'error occured so clear it
Err.Clear
Sheets.Add.Name = "MyIndex"
Sheets("MyIndex").Move After:=Sheets(Sheets.Count)
End If

Set MyWS = ActiveWorkbook.Sheets("Data")

ReDim BoxText(MyWS.Shapes.Count)
For i = 1 To MyWS.Shapes.Count
If Left(MyWS.Shapes(i).Name, 5) = "Text " Then
j = j + 1
BoxText(j) = MyWS.Shapes(i).TextFrame.Characters.Text
End If
Next i
ReDim Preserve BoxText(j)
Sheets("MyIndex").UsedRange.ClearContents
For i = 1 To j
Sheets("MyIndex").Cells(i, 1) = BoxText(i)
Next
End Sub


and also the following which calls the code, to keep things up to date

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
GetBoxText
End Sub



You can then run a slightly modified version of DRJs FinalAll programme as attached.

I'm sure with your experience now, you can iron out any version bugs!:bore

MD

Airborne
11-05-2004, 06:00 PM
Thanks Ken, have a good weekend.

Airborne
11-05-2004, 06:10 PM
Thanks MD, I'll try out your suggestion. :yes


Regards.

Airborne
11-06-2004, 04:17 AM
Hi Ken and MD, I've been playing around a bit with the index code. But if I understand correctly, should I put it in my workbooks from now on?:wot We have about 5000 files, containing two sheets, stored. I can't search in them. Maybe I'm wrong.

I'd rather use the following idea.....
Windows search doesn't open the files but just shows the files in the search window containing the hits. You can open them yourself. Is it not possible that Ken's routine not opens the files but just shows them in an extra page of my Data.xlt workbook. As you know it contains the "data" and "stock" sheet and I can also add a "search" sheet. The workbook contains Ken's routine and other routines (one to copy/paste the two sheets in a new workbook giving it the name Datadd-mm-yyyy.xls (containing no macro's) storing it in year\etc. We then close the Data workbook again.:roll:

I realy want to stick to Ken's setup because apart from the IT pc problem it works fine.:yes


Thanks and regards.

mdmackillop
11-06-2004, 06:50 AM
I would not advocate putting my code into 5,000 sheets unless it was going to rain very heavily all day for a week. That said, I think that having created an index sheet containing the data from all files, having code in each new workbook to keep the index updated is still a possibility. Another consideration is whether you ever change the text in the textboxes of existing workbooks.
Unfortunately, Ken's code won't run on my PC, maybe its time to upgrade!
MD

Airborne
11-07-2004, 08:29 AM
Hi MD, "Another consideration is whether you ever change the text in the textboxes of existing workbooks." Yes we sometimes change text in the last current workbooks. I have a routine for that. I got it a while ago from DRJ. It opens the workbook of a selected date from the workbook with all the routines.

I hope you don't blame me for needing a upgrade;) .

Thanks and regards.

Airborne
11-10-2004, 06:06 AM
:hi: Hi, talked to the IT guys. Excel was damaged on three IT pc's. After a repair.....everything worked. A steady screen and a working bar:dance: . As soon as I have a reply from Ken I will call this thread solved.

Thanks all for the help.

Regards.

Ken Puls
11-11-2004, 12:04 AM
Hi Airborne,


:hi: Hi, talked to the IT guys. Excel was damaged on three IT pc's. After a repair.....everything worked. A steady screen and a working bar:dance: .Excellent! One issue down, at least! :cool:


Windows search doesn't open the files but just shows the files in the search window containing the hits. You can open them yourself. Is it not possible that Ken's routine not opens the files but just shows them in an extra page of my Data.xlt workbook. As you know it contains the "data" and "stock" sheet and I can also add a "search" sheet. The workbook contains Ken's routine and other routines (one to copy/paste the two sheets in a new workbook giving it the name Datadd-mm-yyyy.xls (containing no macro's) storing it in year\etc. We then close the Data workbook again.Hmmm... The problem that I see here is that with the data stored in textboxes, I can't find a way to access the various files without opening them. If you were to throw a Workbook_BeforeSave event in the template (that creates all of your data files) to copy all the textbox info to cells on a separate sheet ("search" as referred to above) I think that we could adapt Joseph Rubin's idea here (http://www.exceltip.com/show_tip/Files,_Workbook,_and_Worksheets_in_VBA/Read_information_from_a_closed_workbook_using_VBA_in_Microsoft_Excel/473.html). Even that would be some work, though, as the methodology for this would be to create a link to a sheet in your main workbook from each cell in the search sheet of every file in the directory. You're still talking about setting up a loop to talk to each file in the directory though. Having never used Mr. Rubin's method before, I can't guarantee that it would even be any faster...

It may be possible to just launch windows search utility right from Excel (I'm not sure what to call to do this though), but does it search textboxes within the file? I'm not sure...

PS: MD, I think that the only lines of code that aren't 2000 compliant are the lines calling .ShowWindowsInTaskbar (That one was definately added in 2003). I think that the rest of the code should be backwards compatible.

Airborne
11-11-2004, 09:07 AM
Hi Ken, I hope you don't think by adding this in your reply
Originally Posted by Airborne
Windows search doesn't open the files but just shows the files in the search window containing the hits. You can open them yourself. Is it not possible that Ken's routine not opens the files but just shows them in an extra page of my Data.xlt workbook. As you know it contains the "data" and "stock" sheet and I can also add a "search" sheet. The workbook contains Ken's routine and other routines (one to copy/paste the two sheets in a new workbook giving it the name Datadd-mm-yyyy.xls (containing no macro's) storing it in year\etc. We then close the Data workbook again.
That your module doesn't work because it does work and it works great! I have a search engine that works and a status bar that looks cooler than the one WindowsXP shows. I meant that the search engine in WindowsXP doesn't show opening files when you look at the screen. Your module doesn't show opening files either. The only thing is that after te search the sheets with the hits are all showing in the task bar and after WindowsXP search the files with the hits are shown as hyperlinks in the search window. With a lot of files open the last case seems slightly better.

It's not really a problem though. It's more nice to have;) . I have heaps of other questions about VBA that I can't solve at the moment so how about calling this thread solved so you can help me with my other questions:blush :fright:

Regards.

Ken Puls
11-11-2004, 09:17 AM
Hi Airborne,


I have a search engine that works and a status bar that looks cooler than the one WindowsXP shows.That's some pretty high praise! :giggle

Sorry, I didn't follow you earlier. So basically it's just a matter of cleaning up the taskbar at the bottom of the screen then? We can certainly close the workbook when a "hit" is found, and add a hyperlink to it in a sheet if that's what you're after...

Does that sound right?

You'd just need to capture the file name/directory when you add the hyperlink objects. Look up Hyperlinks in the KB to get yourself started with a few different ways of using them.

HTH,

Airborne
11-11-2004, 09:54 AM
:yes Ken. After the search is finished and I have, for instance, found 5 files with hits, they are all crowded together in the taskbar. You can click on them and see the sheet with the searched word(s). Now 5 is a crowd but if you find 10 sheets. So the idea was not showing the open files in the taskbar but as hyperlinks on a extra sheet in the workbook with the search engine. I can add a sheet called Found (it will be hidden and only open when the sheet has hyperlinks on it after a search).:wot

As I told before, it's nice to have(but again cool:cool ).

You'd just need to capture the file name/directory when you add the hyperlink objects It's not JUST for me:blush ...... :D .

Regards.

Ken Puls
11-11-2004, 12:55 PM
Hi Airborne,

You're actually closer than you know... In the findall routine, the following line inside the file loop gives you the full path right to the workbook:

Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
The WB variable can be used to set the target address of the hyperlink as it then holds the full path including file name. What we'll need to do is change the loop to close the workbook regardless of match or not, but add the hyperlink if it matches. It should be a pretty minor change overall. I'll take a look at it later tonight, if you don't solve it first. ;)

Cheers,

Ken Puls
11-11-2004, 11:34 PM
:blush Ooops! To clarify the above, SearchPath & "\" & FileName gives you the full path right to the workbook.

At any rate... Name a sheet "Found" in the workbook that runs the code, and replace the FindAll routine with this:

Option Compare Text
Option Explicit
Sub FindAll(SearchPath As String, SearchText As String, ToProcess As Integer)
'Macro purpose: Loop through all Excel Workbooks and search each of them for the
'specified criteria
Dim WB As Workbook
Dim WS As Worksheet
Dim FileName As String
Dim TermFound As Boolean
Dim i As Integer
Dim Processed As Integer
Dim BoxText As String
Dim Problem As Boolean

'Turn off screen flashing & taskbar updates
With Application
.ScreenUpdating = False
.ShowWindowsInTaskbar = False
End With

'Clear the list of hyperlinks from the "Found" sheet
With ThisWorkbook.Worksheets("Found")
.Range("A2:A" & .Range("A65536").End(xlUp).Row).ClearContents
.Range("A1").Value = "Location of workbooks holding the term: " & SearchText
End With

'Assign first filename in directory to FileName variable
FileName = Dir(SearchPath & "\*.xls", vbNormal)

'Expand ufSearch to show progress bar
With ufSearch
.Height = 174
.Repaint
End With

Do
'Set problem to false then attempt to open workbook and set WB & WS variables
'(If an error results, set the Problem variable to true)
Problem = False
On Error Resume Next
Set WB = Workbooks.Open(FileName:=SearchPath & "\" & FileName, ReadOnly:=True) _
', Password:="Uncomment and put password here if required"
If Err.Number <> 0 Then Problem = True
On Error Resume Next
If Problem = False Then
TermFound = False
For Each WS In WB.Worksheets
'If no error, check all textboxes in the file for search term
For i = 1 To WS.TextBoxes.Count
BoxText = WS.TextBoxes(i).Text
If InStr(1, BoxText, SearchText) > 0 Then
'If the search term is found, set TermFound to true,
'and stop checking further (exit the loop)
TermFound = True
Exit For
End If
Next i
If TermFound = True Then
'If the search term was found add it to the list of hyperlinks
With ThisWorkbook.Worksheets("Found")
.Hyperlinks.Add _
Anchor:=.Range("A65536").End(xlUp).Offset(1, 0), _
Address:=SearchPath & "\" & FileName, _
TextToDisplay:=SearchPath & "\" & FileName
End With
Exit For
End If
Next WS
End If

'Close the workbook
'(On error resume next in case WB never opened at all)
On Error Resume Next
WB.Close False
On Error GoTo 0

'Inform the user how many files have been processed and update the progress bar
Processed = Processed + 1
Call UpdateProgress(Processed / ToProcess)

'Release WB & WS variables and set FileName to next file
Set WB = Nothing
Set WS = Nothing
FileName = Dir() 'sets FileName to next file in directory
Loop Until FileName = ""

'Restore screen updating, show open files on taskbar and clear statusbar
With Application
.ScreenUpdating = True
.ShowWindowsInTaskbar = True
End With

'Hide the progress indicator
With ufSearch
.Hide
End With

'Inform the user how many files were opened (number of opened files)
MsgBox WorksheetFunction.CountA(ThisWorkbook.Worksheets("Found").Range("A2:A" & _
ThisWorkbook.Worksheets("Found").Range("A65536").End(xlUp).Row)) _
& " files were found which matched your search term!", _
vbOKOnly + vbInformation, x & " Files Found!"
ThisWorkbook.Worksheets("Found").Activate
End Sub

I think that should do what you're after... (FYI, it will overwrite the list every time you run it as well, so no need to clear it out.) :yes

Let me know!

Airborne
11-12-2004, 01:44 PM
:bigdance2 Well Ken, that's it! Your project is not only working great but it's :cool cool too. Thanks very much.

Maybe it's a dumb question but.... .Range("A2:A" & .Range("A65536").End(xlUp).Row).ClearContents
.Range("A1").Value = "Location of workbooks holding the term: " & SearchText .....what is meant by ("A65536")? How can I put the hyperlinks in cells B3, B4, etc?:blush

Thanks again for all your time and trouble:super: .

Regards.

Ken Puls
11-12-2004, 01:55 PM
Well Ken, that's it! Your project is not only working great but it's :cool cool too. Thanks very much.

.....what is meant by ("A65536")? How can I put the hyperlinks in cells B3, B4, etc?:blush

Thanks again for all your time and trouble:super: .

Regards.
You're very welcome. I've had some fun with it!

As far as "A65536", it's the last cell in column A (until Microsoft evenutually gives us more rows :vv , 65536 is the last one in any workbook) Tacking the end(xlup) on it sends it up to the last used cell in Column A, be it A65 or A897, etc...

To change the hyperlink list to column B, just change the following lines:

Anchor:=.Range("A65536").End(xlUp).Offset(1, 0), _
To
Anchor:=.Range("B65536").End(xlUp).Offset(1, 0), _

And

.Range("A2:A" & .Range("B65536").End(xlUp).Row).ClearContents
To
.Range("B2:B" & .Range("B65536").End(xlUp).Row).ClearContents

This leaves the title in column A, so you may want to update that line to column B as well. (This one: .Range("A1").Value = "Location of workbooks holding the term: " & SearchText)

Cheers,

Airborne
11-12-2004, 02:06 PM
:yes Thanks Ken for my last lesson in this thread. I will call this thread solved.


Take care and regards.

XLGibbs
02-25-2006, 06:53 PM
Just a point of interest on this cool thing...with excel 2007 coming,may be prudent to change the references to be more like:

Anchor:=.cells(.rows.count).End(xlUp).Offset(1, 0), _
to account for the additional rows (1.1 million or so total) that will be available.

Ken Puls
02-25-2006, 09:56 PM
Agreed, Pete. Bob converted me to the .rows.count method after I worked on this with Airborne. ;)