Speeding up this code- when a custom function is used many times

[ker_01]

I mostly work in 2003, but I'm working on a project to help out a co-worker
who uses 2007. I have two problems (I'll post them separately to keep the
discussion threads clean)

I've written a custom function (below) which is being used to reconcile data
across
two worksheets in the same workbook. The function is used in several thousand
cells. There is a lot of data being processed, and it takes several minutes
to update the workbook.

This takes far longer than I would have expected, and I see a couple of
problems with my approach (I just don't know how to fix them).

(1) If there was a way to turn off recalculation and screenupdating at the
beginning of the first (of thousands of) cell update(s) and turn it all on
back at the very end, I think that would speed it up....but the formula is
separate in those thousands of cells, which I believe calls the function
separately for each cell- and I don't know how to tell when the first call
starts and the last one finishes, as opposed to any random one in between.

(2) I have to adjust for case sensitivity and remove the tail end of an
email address. Truth is, I should only have to do that once for the whole
list... but again, I'd need to know when the function was first triggered,
and not do it each time the function was called within a single recalculation

I'd welcome any advice on how to better design my function, including
anything else that might speed this up.

Many thanks,
Keith


Code:
Function PullOverData(SentToAddress As Range, BrainSharkAddress As Range,
BrainSharkData As Range)

Dim Col2 As Variant
Dim Col3 As Variant

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Col1 = SentToAddress
Col2 = BrainSharkAddress.Value
Col3 = BrainSharkData.Value

If (InStr(Col1, "@")) = 0 Then
SourceEmailValue = LCase(Col1)
Else
SourceEmailValue = LCase(Left(Col1, InStr(Col1, "@") - 1))
End If

For i = LBound(Col2) To UBound(Col2)
If Col2(i, 1) = "" Then Exit For
AtFound = InStr(Col2(i, 1), "@")
If AtFound = 0 Then
Col2(i, 1) = LCase(Col2(i, 1))
Else
Col2(i, 1) = LCase(Left(Col2(i, 1), AtFound - 1))
End If

'UseRow = Application.Match(SourceEmailValue, Col2, False)
If Col2(i, 1) = SourceEmailValue Then
PullOverData = Col3(i, 1)
Exit Function
Else
PullOverData = ""
End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Function

 

[Joel]

Why are you using a function? Why not just use a sub?

You can use an input box with type 8 to alow the user to specify the range
of addresses or just perform code on entire worksheet.

Another approach would be use a named range to specify your range you want
to perform the macro on.

Using a function is slowing down the code.


to locate the @ sign in a row try the find function

set c = Rows(5).find(what:="@",lookin:=xlvalues,lookat:=xlpart)

 

[Dougaj4]

Keith - can you bring in the data for all several thousand cells as
arrays, and return the result as an array formula? If you can the
function will be very much quicker, but it does mean that the data
would have to be in contiguous ranges.

 

[Tim Zych]

Setting SceenUpdating and Calculation won't work in a UDF. UDFs can't modify
certain environmental features such as screen updating, calculation,
formatting, etc.

e.g.

Function Func1() As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.Caller.Interior.ColorIndex = 6

Debug.Print (Application.ScreenUpdating = True) ' remains on
Debug.Print (Application.Calculation = _
xlCalculationAutomatic) ' remains Automatic
Debug.Print (Application.Caller.Interior.ColorIndex = 6) ' did not
change the color

Func1 = 5

End Function

Just a note that it is not working the way you think it may, so removing
those calls may help speed it up a bit.

Maybe you can modify the UDF to branch off depending on which cell is being
processed (to your point about issue #2), e.g.

' e.g. =Func2(A1:E1)
Function Func2(ByVal rng As Range) As String
Dim cell As Range
For Each cell In rng.Cells
' If this is the last cell in the parameter, do one thing
If Not Application.Intersect(cell, rng.Cells(rng.Cells.Count)) Is
Nothing Then
' If E1 = "x"...
If cell.Value = "x" Then
Func2 = rng(rng.Cells.Count).Value
End If
Else
' Otherwise, process normally
Func2 = Func2 & ":" & cell.Value
End If
Next
End Function

But to your bigger question -- linking the UDFs together so that the first
one knows about the last one -- goes against the basic design of a UDF, IMO.
UDFs should remain as independent as possible for maximum flexibility. As
soon as one UDF has to know the possible whereabouts of another UDF, they
forever remain joined in some way, limiting their modularity and usability.



--
Regards,
Tim Zych
http://www.higherdata.com
Workbook Compare - Excel data comparison utility

http://www.higherdata.com/sql/batchsqlfromexcel.html
Create batch SQL from Excel

 

[Charles Williams]

As Tim Zych says, Excel ignores screenupdating and manual calculation
changes inside a UDF.

You can speed up calculation a lot by changing calculation to Manual rather
than automatic and initiating calculation from VBA rather than Excel. This
bypasses a long-standing bug which refreshes the VBE title bar twice each
time a formula containing a UDF is calculated (so several thousand times in
your case). Application.screenUpdating does not affect the VBE so will not
bypass this problem.

(See http://www.decisionmodels.com/calcsecretsj.htm )

add this to the workbook open sub so that it traps F9

Application.OnKey "{F9}", "CalcBook"

then add this sub to the module containing your UDFs

Public Sub CalcBook()
Application.Calculate
End Sub

Charles
___________________________________
The Excel Calculation Site
http://www.decisionmodels.com