LinkBack URL
About LinkBacksHello
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
Register To Reply
Bookmarks