Speed up the search?

[Ann]

I am running the VBA below. It works great, but slow. I have 2000+ account
numbers that have to be looked for in 20 different files.

Currently, it works like this:
Opens File1, search for Acct #1, Close File1
Open File2, search for Acct#1, Close File2....

and so on, until it either finds the Acct # or has searched all the files.
Then it starts over, searching for Acct #2......it takes about 15 minutes to
run through 25 Acct #'s.

Is there a way to speed this up? Any ideas?
Thanks,
Ann

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 i = 1 To eAc
AcNo = Sheets("Sheet1").Cells(i, 1).Value

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
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"
Exit For
End If
Next sh
.Close False
End With
Set objFile = Nothing
End If
Next
With Sheets("Sheet1").Cells(i, 2)
If .Value <> "Yes" Then .Value = "No"
End With
Next i

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

 

[TomHinkle]

The only way you will get this SIGNIFICANTLY faster is to use a database (NOT
Excel)

You could make minor gains by combining all the files first and then sorting
them. But it won't be much.

 

[bpeltzer]

It looks like you're opening and closing 500 files to search for those 25
accounts! Could you restructure so that you open file 1, search for all
accounts. Open file 2, search for all accounts not yet found, etc.
(Alternatively, if you know that most accounts will be matched in the first
file or two, you could just change it so that after a match it moves on to
the next account. I think now a match just allows it to skip searching
further sheets in the current file, but doesn't preempt searching the
remaining files).

 

[Ann]

Yes, that seems more logical to me. But I did not write the original code,
and I'm at a loss to make the changes. Any suggestions?

Thanks,
Ann

 

[Tom Ogilvy]

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


should be faster

 

[Ann]

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

Thanks,
Ann