Final version follows for anyone interested...
Sub FindSheetsWithID_v6()
' Looks for an ID on all sheets with search tag,
' and outputs results to summary sheet named "Instructions".
' Note: The search tag is a local scope defined name range
' that contains the search data column address.
Dim Wks As Worksheet, wksTarget As Worksheet, rng As Range
Dim sOut$, sAddr1$, lCount&, n&, vData
Const sRngToSearch$ = "MyTag" '//edit to suit
Set wksTarget = ThisWorkbook.Sheets("Instructions")
'Assume comma delimited ID list stored in named range
With wksTarget
.Activate: vData = Split(.Range("IdList").Text, ",")
End With
If VarType(vData) < vbArray Then Exit Sub
On Error GoTo Cleanup
ReDim vDataOut(UBound(vData))
For n = LBound(vData) To UBound(vData)
sOut = ""
For Each Wks In ThisWorkbook.Worksheets
If bNameExists(sRngToSearch, Wks) Then
sOut = sOut & "," & Wks.Name & "=": sAddr1 = ""
With Wks.Range(sRngToSearch)
Set rng = .Find(What:=vData(n), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
sAddr1 = rng.Address
Do
lCount = lCount + 1: Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address < sAddr1
End If 'Not rng Is Nothing
End With 'Wks.Range(sRngToSearch)
sOut = sOut & lCount: lCount = 0
End If 'bNameExists
Next 'Wks
vDataOut(n) = Split(vData(n) & "|" & Mid$(sOut, 2), "|")
Next 'n
'Output to worksheet
Xform_1DimArrayOfArraysTo2D vDataOut
With wksTarget.Cells(Rows.Count, "A").End(xlUp)(2)
.Resize(UBound(vDataOut), UBound(vDataOut, 2)) = vDataOut
.EntireColumn.NumberFormat = "@"
End With
Cleanup:
Set wksTarget = Nothing: Set rng = Nothing
End Sub
--
Garry
Free usenet access at
http://www.eternal-september.org
Classic
VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.
vb.general.discussion