Hi Howard,

Am Wed, 25 Jun 2014 17:55:55 -0700 (PDT) schrieb L. Howard:

How do I get the last line to put the found strings in individual cells on the sheet instead of all in K2 as it now does.

write the matches in an array at once.
Try following code. The matches will be written in Sheet(1).

Sub FindSheetsWithID()

Dim wsh As Worksheet, c As Range
Dim strID As String, FirstAddress As String
Dim arrIn() As Variant, arrOut As Variant, myDic As Object
Dim n As Long, i As Long, LRow As Long

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

For Each wsh In ThisWorkbook.Sheets
If Not wsh.Name = "Sheet1" Then
Set c = wsh.UsedRange.Find(What:=strID, _
LookIn:=xlValues, _
LookAt:=xlWhole)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
ReDim Preserve arrIn(n)
arrIn(n) = wsh.Name
n = n + 1
Set c = wsh.UsedRange.FindNext(c)
Loop While Not c Is Nothing And c.Address < FirstAddress
End If
End If
Next

If n 0 Then
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(arrIn) To UBound(arrIn)
myDic(arrIn(i)) = arrIn(i)
Next
arrOut = myDic.items
End If


With Sheets(1)
LRow = .Cells(Rows.Count, "A").End(xlUp).Row
If n 0 Then
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1).Resize(columnsize:=myDic.Count) = arrOut
Else
.Range("A" & LRow + 1) = strID
.Range("B" & LRow + 1) = "Not found"
End If
End With

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional