hi,
here is some code i wrote a very years ago when my boss want to know how
many time a part number appeared in all of the files we were saving off.
it's older code so MVP forgive the mental wanderings. but it worked. you
will have to change certain lines in the code. the code assumes that all of
your search files are in one directory(folder).
lines to change...
MyPath = "h:\excel\MRPLocQtyByDate\" line 19
change to your file path...
Windows("CountWB.xls").Activate line 51 & 63
change to your count workbook.
also study the dims to see if you need all those.
example code only. use at your own risk.
code....
Sub macFindInfoStuff()
Dim mybook As Workbook 'an excel workbook- used at line 39
Dim FNames As String 'workbook(or file) name - used at lines 24,
25, 33
Dim MyPath As String 'file path - use at lines 15,16,18,19,35
Dim SaveDriveDir As String 'current directory - used at lines
14,23,24,73,74
Dim cnt As Long 'counter to count Workbooks - used at lines
29,69,72
Dim cnt2 As Long
Dim cnt3 As Long
Dim c As String 'string to find in workbook - used at lines
31,32,36
Dim rng As Range 'range to search - used at lines
36,43,44,45,49,56,57,61,62,65
Dim Infocell As Range 'cell offset from rng. wanted info of rng
Dim sAddr As String 'range address of first find - used at lines
44,51,57,66

SaveDriveDir = CurDir 'Mark current directory
prior to search
'MyPath = InputBox("Enter a File Path") 'Get file path from inputbox
'MyPath = Range("B3").Value 'or get file path from cell
address
MyPath = "h:\excel\MRPLocQtyByDate\" 'Or state file path in code

Range("B3").Value = MyPath 'display path in file(cell)
ChDrive MyPath 'change to path drive
ChDir MyPath 'change to path directory
FNames = Dir("*.xls") 'state type of file to search
If Len(FNames) = 0 Then 'if not xls then abort
MsgBox "No files in the Directory" 'message to user
ChDrive SaveDriveDir 'go back to previous drive
ChDir SaveDriveDir 'to back to previous directory
Exit Sub 'exit the code
End If
cnt = 0 'counter to count workbooks
cnt2 = 0
cnt3 = 0
c = InputBox("Enter something to find") 'request search string via
input box
If c = "" Then Exit Sub 'if no input in inputbox,
exit the code
Do While FNames < "" 'loop through xls's untill
last workbook
Set mybook = Workbooks.Open(FNames) 'open first workbook

Set rng = Range("A1:IV65000").Find(What:=c, _
After:=ActiveCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False) 'find search
string(c)

If Not rng Is Nothing Then 'if not
found, next workbook
sAddr = rng.Address 'if find,
set first address
rng.Select 'select the
found search string
Set Infocell = ActiveCell.Offset(0, 4) 'set the
wanted info in relation to rng
Windows("CountWB.xls").Activate 'return the
wanted info
Range("B65000").End(xlUp).Offset(1, 0).Value = rng
Range("B65000").End(xlUp).Offset(0, 1).Value = Infocell
Range("B65000").End(xlUp).Offset(0, 2).Value = sAddr
Range("B65000").End(xlUp).Offset(0, 3).Value = FNames
cnt2 = cnt2 + 1
Windows(FNames).Activate 'back to
search workbook
Do
Set rng = Range("A1:IV65000").FindNext(rng) 'look
for more
If rng.Address = sAddr Then 'if
same addres, stop looking
Exit Do 'next
workbook
End If
Windows("CountWB.xls").Activate 'return other found
info
Set Infocell = rng.Offset(0, 4)
Range("B65000").End(xlUp).Offset(1, 0).Value = rng
Range("B65000").End(xlUp).Offset(0, 1).Value =
Infocell
Range("B65000").End(xlUp).Offset(0, 2).Value =
rng.Address
Range("B65000").End(xlUp).Offset(0, 3).Value = FNames
cnt3 = cnt3 + 1
Windows(FNames).Activate 'back
to search workbook
Loop Until rng.Address = sAddr 'stop
when loop to first find
End If
mybook.Close True 'close the workbook
cnt = cnt + 1 'count it
FNames = Dir() 're-sets FName(file Name)
to null
Loop
MsgBox ("The " & MyPath & " Directory contains " & cnt & " excel files")
Range("E3").FormulaR1C1 = "The " & MyPath & " Directory contains " &
cnt & " excel files"
Range("E2").FormulaR1C1 = c & " found " & cnt2 + cnt3 & " times in " &
cnt2 & " excel files"

ChDrive SaveDriveDir 'back to precious drive
ChDir SaveDriveDir 'back to previous directory
Application.ScreenUpdating = True

End Sub

regards
FSt1
"dutton.dn" wrote:

Trying to create a counted total of occurrences that a specific string is
found in multiple spreadsheets, (ie: look for the string "Montana" across
more than 50 different Excel documents) returning a counted single result in
a single spreadsheet.