Macro runs slow

[Sandy]

Hello
I posted this in General Question but now feel that it probably would be
better served here.....
I have a third party file that I use in conjunction with some of my own
files. If I open their file alone the file performs as expected in terms of
response time. However when I open my files the response goes from almost
instantaneous to taking about 40 seconds. If I do repair when I open my
file, the response is somewhat better but as soon as I save that file it
reverts to the "SLOW" mode. I have deleted all macros in my file but this
makes no difference. If I open a file of the relatively same size
(600-700kb) their file works fine. Does any one have any ideas what may be
casuing this problem?

I have found that if I delete an arbirtary sheet or add a blank sheet
the problem also goes away. But once saved and reopened the file it goes
back to its old slow self. I did get the third party to release their code,
but it is reather extensive. I will gladly post if it is a help but it seems
as though that it is an Excel issue rather than code in that the code runs
quickly when only the one file is open. If I turn off auto calc it works as
though only their file is open. One of my files (that causes this behavior)
has a macro that copies one sheet out to a new workbook(Values only no links
no calcs no macros) and with only this newfile open with their file, the
response bogs down. They sent me one of the macros that gets bogged down in
a book by itself and I am still having the problem. Thier code goes way
beyond my understanding. Does anyone see anything that might be causing a
problem?

Sub Initialize()
Dim szPath As String, szDrive As String

szPath = ThisWorkbook.Path
szDrive = Left(szPath, 1)

If (Right(szPath, 1) = "\") Then
szPath = szPath & "Region"
Else
szPath = szPath & "\Region"
End If

ChDrive (szDrive)
ChDir (szPath)

End Sub

Function Exist(fName As String, Optional attr As Integer = vbNormal)
'
'If attr = vbDirectory ==> Check directory
'
If (Trim(fName) = "") Then
Exist = False
Exit Function
End If
Exist = Len(Trim(Dir(fName, attr))) <> 0
End Function

Function YYMMDDtoDate(yy As Integer, mm As Integer, dd As Integer) As Date
Dim dstr As String
dstr = Trim(Str(mm)) & "/" & Trim(Str(dd)) & "/" & Trim(Str(yy))
If IsDate(dstr) Then
YYMMDDtoDate = DateValue(dstr)
Else
YYMMDDtoDate = DateValue("01/01/01")
End If
End Function

Sub ForecastTemp()
Dim mcell As Object
Dim ndata As Integer
Dim fno As Integer, ncol As Integer, hr As Integer
Dim yy As Integer, mm As Integer, dd As Integer
Dim mdate As Date
Dim sTemp As String, fName As String
Dim ss As String, sName As String
Dim tok As New Tokenizer

Call Initialize
fName = "Temp.for"
If (Not Exist(fName)) Then
MsgBox "The desired file " & fName & " does not exist!",
vbExclamation, "Error"
Exit Sub
End If

sName = "Sheet1"
Set mcell = Sheets(sName).Range("B2").Cells
Sheets(sName).Range("B1:Z1000").Clear

fno = FreeFile
Open fName For Input As #fno
ncol = 0
While (Not EOF(fno))
Input #fno, ss
Call tok.Initialize(ss)
yy = Val(tok.NextToken())
mm = Val(tok.NextToken())
dd = Val(tok.NextToken())
mdate = YYMMDDtoDate(yy, mm, dd)
mcell.Offset(0, ncol).Value = Format(mdate, "mm/dd/yyyy")
For hr = 1 To 24
ndata = Val(tok.NextToken())
mcell.Offset(hr, ncol).Value = ndata
Next hr
ncol = ncol + 1
Wend
Close (fno)

End Sub

Temp.for is a text file that is laid out as follows.
A1=YR
B1=M
C1=DD
D1:AA1 are 24 hourly forecasted temperatures
there are 7 days of data in A1:AA7

When the macro runs the data is reformatted with the day1 Date in B2
(DDMMYYYY) with temps for hours 1-24 in the column below it. Day 2 in C2 etc.

Thanks in advance for the help

 

[Tom Ogilvy]

Think you have already stated what the problem is. If you turn off
autocalc, it runs fine. So turn off autocalc before you run the macro.

 

[Sandy]

I guess then my question is why does it act this way with the single page
workbook with no calculations links or macros, and not with other workbooks?
as my manager says this is just a "bandaid".

 

[Peter T]

Maybe calculations occur that you're unaware of. To see what's going on -

Add a Class module named Class1

' in Class1
Public WithEvents xl As Excel.Application

Private Sub xl_SheetCalculate(ByVal Sh As Object)
Debug.Print Sh.Parent.Name, Sh.Name
End Sub

Private Sub xl_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox 11
End Sub
''''''''''''''

and in a normal module -

' in a normal module
Dim clsAPP As Class1

Sub SetAppEvents()

Set clsAPP = New Class1
Set clsAPP.xl = Application

End Sub
'''''''''''

Run SetAppEvents, then run your problematic addin. Look in the immediate
window Ctrl-g.

If it appears calculation events are unexpectedly occurring, add the
xl_SheetChange event to the Class and debug print Target address & value.

Regards,
Peter T

 

[Sandy]

Thanks for the input
I dont see how there can be any calcs---this sheet is a copy paste vales only
Sandy

 

[Peter T]

So why is it if you disable Calc everything runs OK !

Regards,
Peter T

 

[Bill Martin]

Thanks for the input
I dont see how there can be any calcs---this sheet is a copy paste vales only
Sandy

That's the perennial problem with debug. We convince ourselves that "X" can't
be the problem, so we don't examine X closely -- until a week later.

Bill

 

[Sandy]

Tell me! Thats the part I dont understand, and why adding a blank sheeet
helps until the file is saved and reopened.

 

[Sandy]

Im not quite sure what you are trying to say. Ive looked at this problem
every way I know how.

 

[Peter T]

I know only too well that things like this can be difficult to identify, as
often as not ends up being something ridiculously obvious. Run
SetAppEvents() and look at the calc event and possibly the Sheet change
event.

Remove my "MsgBox 11", which was only there to test the event worked, and
replace with say
debug.print target.address.

But primarily look at anything that's printed to the immediate window from
the calc event, which should trap any calc in any sheet in any workbook.
Obviously do this with Calc on. If no events are triggered at least you can
know and can look for something else.

Regards,
Peter T


Try the App' events code I suggested. You can insert into any workbook

 

[Sandy]

I have done that an nothing shows up in the immediate window
Thanks