View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
ker_01 ker_01 is offline
external usenet poster
 
Posts: 395
Default Speeding up this code- when a custom function is used many times

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