microsoft.public.excel.programming

alok

12/20/2006 1:32:00 PM

Normally I put a

Application.Calculation = xlCalculationManual
at the beginning of the code and
Application.Calculation = xlCalculationManual
at all those points in the code from where the code can exit the subroutine.

If the subroutine will be called by other subroutines then it is better to
do the following

1. First save the existing value of Application.Calculation
2. Set it to xlCalcuationManual
3. set it back to the saved value at the exit points.

Alok

"Newbie" wrote:

> I have the following code, which works, but is very slow .. can anyone please
> help me speed it up ?
>
> Sub scandirectory()
> Application.DisplayAlerts = False
> r = 1
> wr = 1
> Dim Wb1, wb2 As Workbook
> Dim i As String
> Set Wb1 = ActiveWorkbook
> Set FSO =
> CreateObject("Scripting.FileSystemObject").GetFolder("C:\2007\Budget
> 2007\061212")
> For Each file In FSO.files
> If file.Type = "Microsoft Excel Worksheet" Then
> With file
> Workbooks.Open (file)
> Set wb2 = ActiveWorkbook
> For Each ws In wb2.Worksheets
> If ws.Tab.ColorIndex = 4 Then GoSub hit
>
> Next
> wb2.Close
>
> End With
> End If
> Next
> Set FSO = Nothing
> Application.DisplayAlerts = True
> End
>
>
> hit:
>
>
> On Error Resume Next
>
> sname = ws.Name
> For Each ce In ws.Range("c9:n95")
>
> m = Application.VLookup(Chr(ce.Column + 64), Range("months"), 2, 0)
> i = Application.VLookup(ce.Row, Range("items"), 2, 0)
>
> 'exclusions
> If ce.Value = 0 Then GoTo 100
> If ce.Row = 30 Or ce.Row = 31 Or ce.Row = 32 Or ce.Row = 33 Then GoTo 100
> If ce.Row < 30 Then rc = "Rev" Else rc = "Costs"
> 'NEED TO EXCLUDE TOTAL SHEETS!!
>
>
> 'write data
>
> Wb1.Sheets("data").Cells(wr, 1) = wb2.Name
> Wb1.Sheets("data").Cells(wr, 2) = sname
> Wb1.Sheets("data").Cells(wr, 3) = Chr(ce.Column + 64)
> Wb1.Sheets("data").Cells(wr, 4) = ce.Row
> Wb1.Sheets("data").Cells(wr, 5) = ce.Value
> Wb1.Sheets("data").Cells(wr, 6) = ""
> Wb1.Sheets("data").Cells(wr, 7) = 2007
> Wb1.Sheets("data").Cells(wr, 8) = m
> Wb1.Sheets("data").Cells(wr, 9) = i
> Wb1.Sheets("data").Cells(wr, 10) = rc
>
> wr = wr + 1
>
> 100
> Next
>
> Return
>
> End Sub