VBA Function gets slower every time I use it...

[Guest]

Hi all

I have a function which splits text for me.
I autofit the width of the column and compare
it to the width that i have declared. if the column
width is wider than mine, i go to the next line.
this functions works slow, but I've noted, that
every time the function runs again, it is getting
slower. first time it runs about 30seconds, 2nd
time it runs 45seconds, 3rd time more then a
minute!! I don't know why this happens, could
that have something to do with memory which
isn't released exactly?

Thanks for any help

Carlo

 

[T. Erkson]

Just curious, are you using ScreenUpdating?

Sub yourSubHere()
Application.ScreenUpdating = False
...your code here...
Application.ScreenUpdating = True
End Sub

 

[Guest]

Hi Toby

yes i do. And i even use:
Application.Calculation = xlCalculationManual

altough both help me to make the code faster
they don't prevent that ig gets slower every
time. Only when i close excel and open it again
it runs again faster.

Thanks for your reply

Carlo

 

[NickHK]

Carlo,
Depends somewhat on what you code actually does.
Sure it's not working on a larger set of data each time ?

NickHK

 

[Guest]

Hi NickHK

with the exact same data, 4 times in a row i get following times:
18sec
25sec
37sec
45sec
it takes more or less 50% longer each time.
this is the code i'm using. If i do any bigger mistakes, please tell me, I'm
eager to learn from mistakes I do:
-------------------------------------------------
Sub TextSplit(TextSplit As String, EndRange As Range, ColWidth As Double,
ColLength As Byte, RowsDel As Byte)

Debug.Print "Start:", Time

Dim tmpstr As String
Dim ApprovedStr As String
Dim Arrstr As Variant
Dim tmparr As Variant
Dim Fontsize_ As Single
Dim Linenr As Integer

ActiveWindow.Zoom = 100

Fontsize_ = 7.5
Arrstr = Split(TextSplit)

ActiveSheet.Range(Chr(EndRange.Column + 64) & EndRange.Row & ":" &
Chr(EndRange.Column + 64) & EndRange.Row + RowsDel - 1).Clear

Columns("IV").Clear
Columns("IV").Font.Size = Fontsize_
Columns("IV").Font.Name = "ITCFranklinGothic LT Book"
Linenr = 1
tmpstr = ""

For i = 0 To UBound(Arrstr)
If InStr(1, Arrstr(i), Chr(10)) <> 0 Then
tmparr = Split(Arrstr(i), Chr(10))
For j = 0 To UBound(tmparr) - 1
tmpstr = Trim(tmpstr & " " & tmparr(j))
ActiveSheet.Range("IV" & Linenr) = tmpstr
Columns("IV:IV").AutoFit
If Columns("IV:IV").ColumnWidth <= ColWidth Then
Linenr = Linenr + 1
Else
ActiveSheet.Range("IV" & Linenr) = ApprovedStr
ActiveSheet.Range("IV" & Linenr + 1) = left(Arrstr(i),
InStr(1, Arrstr(i), Chr(10)) - 1)
Linenr = Linenr + 2
End If
tmpstr = ""
Next j
tmpstr = tmparr(UBound(tmparr))
Else
tmpstr = Trim(tmpstr & " " & Arrstr(i))
If Len(tmpstr) > ColLength Then
ActiveSheet.Range("IV" & Linenr) = tmpstr
Columns("IV:IV").AutoFit
If Columns("IV:IV").ColumnWidth <= ColWidth Then
ApprovedStr = tmpstr
Else
tmpstr = Arrstr(i)
ActiveSheet.Range("IV" & Linenr) = ApprovedStr
Linenr = Linenr + 1
End If
End If
End If
Next i

Range("IV1:IV" & Linenr).copy EndRange
Columns("IV:IV").Clear

Debug.Print "End:", Time

End Sub
-----------------------------------------------------------
I sure hope it's not total crap what i'm trying to do here

Thank you all for your support

Carlo

 

[NickHK]

Carlo,
And how are you calling this routine ?
With which values ?

NickHK

 

[Guest]

Nick,
call Textsplit(activecell.value, activecell.offset(2),32.86,30,50)

and in activecell is a text which is about 800 characters long.
you can take any text you want.

Thanks

Carlo

 

[NickHK]

Carlo,
Using ~1600 chars taken from an email, the routine always runs in ~ 1sec.
Adding a "Application.ScreenUpdating = False" as the first line and
"Application.ScreenUpdating = True" as the last line, makes it seem
immediate.

I can't get anywhere near 18 sec, that alone longer and longer.
Any other functions/events running also, as I can't see why this is cause
your effect ?

NickHK

 

[Dave Peterson]

Do you see the dotted lines that you get after you do a print or print preview?

If you do
Tools|Options|view tab|uncheck display page breaks

does the run time go back to normal?

Since you're changing columnwidths, excel could be figuring out where those
dotted lines go.

You may want to do something like:

Option Explicit
Sub testme()

Dim CalcMode As Long
Dim ViewMode As Long

Application.ScreenUpdating = False

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

ActiveSheet.DisplayPageBreaks = False

'do the work

'put things back to what they were
Application.Calculation = CalcMode
ActiveWindow.View = ViewMode

End Sub

Being in View|PageBreak Preview mode can slow macros down, too.

 

[Guest]

Hi Nick, Hi Dave

sorry for the delay, I hope you are still reading this.

Thanks a lot for your answers.

Nick's answer got me curious, so I tried the whole function in a
new empty sheet. And it only took about a second, it was done
in an instant, also with ~1500 chars.

Now the question is: What is slowing my sheet down?
First of all, my sheet has a size of approx. 2.5MB, don't
know if this makes it that much slower!
I have written a worksheet-function which gets called
every time I update a cell, but this shouldn't happen
anymore because of the line with: XLcalculationmanual
I work with around 20 cameraobjects.
Other than that I have no idea what could make my sheet
that slow.

Thanks a lot for your answers

Carlo

 

[Guest]

If I'm not mistaken, Just turning application.calculation to manual doesn't
prevent worksheet change events from happening.

So everytime you update a cell, your function gets called again, and this
could be why you are having the issue. Try adding this to your code:

Sub worksheet_Change(Target as range)

'VAR
Static bNoRecurse as Boolean

'BEGIN
if bNoRecurse then exit sub

'Turn off recursion
bNoRecurse = true

'Do your work

'Turn Recursion back on
bNoRecurse = false

End Sub

That will ensure your code runs only once through, and will exit out of the
sub everytime a cell is changed. Otherwise if your output is another cell in
the sheet, the code will be activated again and recurse through.
--
*********************
J Streger
MS Office Master 2000 ed.
MS Project White Belt 2003