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.

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.

hi
sub note:
this code resides in a search file named "countWB"
this code colects 4 things.
1. search item (in the original code - Part number or what ever is input
into the input box
2. quatanty (which was 1 column over from item find.( offset(o,1)))
'the above may not be a item you want to colect.
3. cell address where the data was found. for reference purposes.
4. file name in which the data was found.
varibles..
rng... search item (input box)
inforcell...Offset(0,1)qty.(you may not need this. delete line)
saddr....Offset(0,2). cell address founded (change to Offset(0,1) or delete.
fName...Offset(0,3). flie name found it. (change to Offset(0,2) pt delete.

Post back if you have questions.
I'm here to help.
regards
FSt1

"FSt1" wrote:

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.

Another play, which gives better clarity
on the make up going into the total count(s)

In a new sheet,
Use this sub to quickly list all 50 source sheetnames in A3 down

Sub ListSheetNames()
Dim wkSht As Worksheet
Range("A3").Select
For Each wkSht In Worksheets
Selection = wkSht.Name
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Next wkSht
End Sub

Enter
in B1: Montana (the text string to search)
in B2: A:IV (the range to search in each sheet)

Then place in B3:
=COUNTIF(INDIRECT("'"&$A3&"'!"&B$2),"*"&B$1&"*")
Copy down to the last sheetname in col A to return the counts from each
source sheet. Then just SUM col B for the result. Adapt to suit. As-is,
formula can be copied across/filled down to search for other strings in
ranges as may be desired (in C1/C2, D1/D2, etc).

You might want to set calc mode to manual if you're searching in entire
sheets (calc-intensive). Just press F9 to recalc when ready.
--
Max
Singapore
http://savefile.com/projects/236895
xdemechanik
---
"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.