Garry, Id like to try you last suggestion, but am lost as to what or
how that named range should look like.

This v5 uses a comma delimited list stored in a cell named "IdList" on
"Instructions". It creates an array of arrays for all IDs listed on the
'tagged' sheets, then converts that to a 1-based 2D array to 'dump'
into "Instructions" on the next empty row.

Note that any all-numeric IDs return as numeric data (not as text) and
so requires formatting ColA if you want the results for numeric IDs
displayed as text. Complete code follows..



Sub FindSheetsWithID_v5()
' 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 sID$, 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: sID = .Range("IdList").Text
End With
If Trim(sID) = "" Then Exit Sub

On Error GoTo Cleanup
vData = Split(sID, ","): ReDim vDataOut(UBound(vData))
For n = LBound(vData) To UBound(vData)
sOut = vData(n): sID = 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:=sID, 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(sOut, ",")
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

Function bNameExists(sName$, oSource) As Boolean
' Checks if sName exists in oSource
' Arguments:
' sName The defined name to check for
' oSource A ref to the Wkb or Wks being checked
' Returns:
' True if name exists

Dim x As Object
On Error Resume Next
Set x = oSource.Names(sName): bNameExists = (Err = 0)
End Function

Sub Xform_1DimArrayOfArraysTo2D(Arr())
' Restructures a 1D 0-based dynamic array of arrays to a fixed 2D
1-based array
' Arguments:
' Arr() The array of arrays to be converted
'
Dim v1, vTmp(), lMaxCols&, lMaxRows&, n&, k&

If VarType(Arr) < vbArray Then Exit Sub

lMaxRows = UBound(Arr) + 1: vTmp = Arr: Erase Arr
'Get size of Dim2
For n = LBound(vTmp) To UBound(vTmp)
k = UBound(vTmp(n))
lMaxCols = IIf(k + 1 lMaxCols, k + 1, lMaxCols)
Next 'n

ReDim Arr(1 To lMaxRows, 1 To lMaxCols)
For n = LBound(vTmp) To UBound(vTmp)
For k = LBound(vTmp(n)) To UBound(vTmp(n))
Arr(n + 1, k + 1) = vTmp(n)(k)
Next 'k
Next 'n
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