Hi
1. Spot: probably not much you can do as the file has to be opened.
this is not your code which is slow but the opening process. Faster
hardware / harddisk may help :-)

2. Spot: I don't see anything that could slow down the code. But maybe
you have skipped a loop in your posting :-)

3. Spot. only some genral ideas:
- disable application.screenupdating
- disable automatic calculation
while the code runs



--
Regards
Frank Kabel
Frankfurt, Germany

"MDW" schrieb im Newsbeitrag
...
I've been having problems speeding up some code I'm using in Excel. I
allow users to pick a folder - strPath - and loop through each Excel in
the folder. Here's a stripped down version of my code. There are three
very slow sections that account for about 75% of the time it takes to
execute. They're marked inline. If anyone has any ideas what I can do
to speed them up, I'd appreciate it.

The following variables are declared at module level:
Dim strPath As String,strStore As String
Dim objXL As Excel.Application ' A handle into the Excel application
itself
Dim objWB As Excel.Workbook ' The workbook currently being read
through - this will change for each item in the folder
Dim objNewBook As Excel.Workbook ' The workbook we will save
Dim objFSO As Object
Dim objErrFile As Object
Dim lngLastRow As Long
Dim blnError As Boolean
Dim intNumErrors As Integer
Dim shtAccts As Excel.Worksheet, shtTotals As Excel.Worksheet, shtNew
As Excel.Worksheet

Everything else is a local variable:

Dim intTotalFiles As Integer, intCurrentFile As Integer
Dim objFolder As Object
Dim objFile As Object
Dim strFile As String
Dim objRG As Excel.Range, objOther As Excel.Range, objNames As
Excel.Range
Dim lngBottom As Long, J As Long
Dim strErr As String, strType As String, strMsg As String

Set objXL = New Excel.Application
' Create a new book to be the recipient of this data
objXL.SheetsInNewWorkbook = 1
Set objNewBook = objXL.Workbooks.Add
lngLastRow = 2
objXL.SheetsInNewWorkbook = 3

Set shtNew = objNewBook.Worksheets(1)
shtNew.Name = "Account List"

' Create a handle on the user's file system
Set objFSO = CreateObject("Scripting.FileSystemObject")
' We know from the procedure that populated the text box that the
' folder exists, even if it was just created
Set objFolder = objFSO.GetFolder(strPath)

intTotalFiles = objFolder.Files.Count
intCurrentFile = 1

' Loop through all the files
For Each objFile In objFolder.Files

If UCase(Right(objFile.Name, 3)) = "XLS" Then ' This is an
excel file

' BEGIN SLOW SPOT 1 - TAKES AROUND 2 SECONDS
Set objWB = objXL.Workbooks.Open(strPath & objFile.Name)
' END SLOW SPOT 1

' BEGIN SLOW SPOT 2 - TAKES AROUND 2-3 SECONDS
On Error Resume Next
Set shtAccts = objWB.Worksheets("ACCOUNTS")
Set shtTotals = objWB.Worksheets("TOTALS")

If Err.Number = 0 Then ' There was no error

On Error GoTo 0
Set objOther = shtAccts.Range("A4:H850")

' Capture the store number
strStore = shtTotals.Range("E2").Value
If Trim(strBranch) = "" Or IsNumeric(strBranch) =
False Then

strStore = "NONE SUPPLIED FOR " &
UCase(objFile.Name)

Else

strStore = "'" & Format(strStore, String(6, "0"))

End If

On Error Resume Next
shtAccts.Unprotect "p4ssw0rd"
On Error GoTo 0
' END SLOW SPOT 2

' BEGIN SLOW SPOT 3 - TAKES UP TO 4 SECONDS
Set objNames = shtTotals.Range("A8:B19")

For J = 1 To 12

With objNames.Cells(J, 1)

If .Value < "" Then

objOther.Replace .Value, .Offset(0,
1).Value

End If

End With

Next
' END SLOW SPOT 3

' Write headers on the newly created sheet
shtNew.Range("A1") = "Account"
shtNew.Range("B1") = "Opened By"
shtNew.Range("C1") = "Month"
shtNew.Range("D1") = "Store Number"

' The subs below take about a second to run for all
of them
Call rangeData("A4", "B850", strPath & objFile.Name)
Call rangeData("C4", "D850", strPath & objFile.Name)
Call rangeData("E4", "F850", strPath & objFile.Name)
Call rangeData("G4", "H850", strPath & objFile.Name)

Else

Call errorWrite("No sheet ""ACCOUNTS"" found on
workbook " & objFile.Name)
blnError = True
intNumErrors = intNumErrors + 1
Err.Clear

End If

' Make the system think the workbook is saved
objWB.Saved = True
objWB.Close
Set objWB = Nothing

End If ' Else we don't care

intCurrentFile = intCurrentFile + 1

Next