Better...



Sub FindSheetsWithID_v3()
' 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$
Dim bFoundID As Boolean, lCount&, vDataOut

sID = InputBox("Enter a Client ID")
If Trim(sID) = "" Then Exit Sub

'If we got here then initialize sOut
sOut = sID

On Error GoTo Cleanup
Set wksTarget = ThisWorkbook.Sheets("Instructions")
wksTarget.Activate

For Each Wks In ThisWorkbook.Worksheets
'Comment out next line to include all sheets
If bNameExists("MyTag", Wks) Then
sOut = sOut & "," & Wks.Name & "=": sAddr1 = ""
With Wks.Range("MyTag")
Set rng = .Find(What:=sID, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns)
If Not rng Is Nothing Then
sAddr1 = rng.Address: bFoundID = True
End If
If bFoundID Then
Do
lCount = lCount + 1: Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address < sAddr1
End If 'bFoundID
End With 'Wks.Range("G:G")
sOut = sOut & lCount: lCount = 0

'Comment out next line to include all sheets
End If 'bNameExists
Next 'Wks

'Output to worksheet
vDataOut = Split(sOut, ",")
'Next line assumes 1st row contains headings,
'or data already exists.
With wksTarget.Cells(Rows.Count, "A").End(xlUp)(2)
.Resize(1, UBound(vDataOut) + 1) = vDataOut
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