Thanks Tom! Works at lightning speed! (at least, compared to the previous
version).

Thanks,
Ann


"Tom Ogilvy" wrote:

Sub AcNos()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
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 Not fndAc Is Nothing Then
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