Thank you, but it is not working. It opens the file, then stops - leaving the
file open and it has not returned any results (either "Yes" or "No").


I pasted your code in where you directed and the resulting code (that is
stopping) is below. Have I missed something?

Thanks!
Ann

Sub FastAcNos()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim tbox As textbox
Dim AcNo As String
Dim eAc As Long
Dim i As Long
Dim sh As Long
Dim fndAc As Range

On Error GoTo Errorhandler

Application.ScreenUpdating = False

eAc = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set objFolder = objFSO.GetFolder("c:\Documents and Settings" & _
"\zzfy98\My Documents\Test") 'change directory

For Each objFile In objFolder.Files

If objFile.Type = "Microsoft Excel Worksheet" Then

Workbooks.Open Filename:=objFolder.Path _
& "\" & objFile.Name, UpdateLinks:=False

With Workbooks(objFile.Name)

For sh = 1 To .Sheets.Count

bDone = True

For i = 1 To eAc
If LCase(ThisWorkbook.Sheets("Sheet1") _
.Cells(i, 2).Value) < "yes" Then

' All accounts not found

bDone = False

AcNo = ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value

With .Sheets(sh).Cells

Set fndAc = .Find(AcNo _
, LookIn:=xlValues _
, Lookat:=xlPart _
, MatchCase:=True)


End With

If fndAc Is Nothing Then
' ... use Tom's code here to search the textboxes
For Each tbox In .Sheets(sh).TextBoxes
If InStr(1, AcNo, tbox.Text, vbTextCompare) Then 'Acct no found
it textbox:
ThisWorkbook.Sheets("Sheet1"). _
Cells(i, 2).Value = "Yes"
End If
Next
Else ' this is your original code; means acct no found in cells:
ThisWorkbook.Sheets("Sheet1"). _
Cells(i, 2).Value = "Yes"
End If

End If

Next i

If bDone Then
.Close False
Exit Sub
End If
Next sh
.Close False
Set objFile = Nothing
End With
End If
Next

For i = 1 To eAc
With ThisWorkbook.Sheets("sheet1")
If IsEmpty(.Cells(i, 2)) Then
.Cells(i, 2).Value = "No"
End If

End With

Next

Errorhandler:
Application.ScreenUpdating = True
Set objFSO = Nothing
Set objFolder = Nothing
Set objFile = Nothing

End Sub