Speed-up a macro!

Hi
I have 2 macros/functions that take a lot of time to finish the calculations. Is there any possibility to speed up a macro?
If I try to apply one of the functions, it does not even finish to select the column of 300 data. Excel just stops selecting by the first 100 data and then it does not react to any command.
Rgds,
Maca.
:confused:

post your macro's

then I will look at them

Hi ,
Here the first function (for 300 input cells, it takes almost 30 seconds).

Function NewOmega(retArray, Threshold)
Application.Volatile
Dim n As Integer
Dim distrArray
Dim limitArray
Dim helpArray
Dim cumDistrArray
Dim cumCumArray
Dim cum1DistrArray
Dim cum1CumArray
Dim targetArray
Dim helpOmega
Dim om As Double
n = Application.Count(retArray)
If (Threshold < Application.Max(retArray)) And (Threshold > Application.Min(retArray)) Then
ReDim limitArray(n)
limitArray(1) = Application.Min(retArray)
limitArray(n) = Application.Max(retArray)
For i = 2 To n - 1
limitArray(i) = limitArray(i - 1) + (Application.Max(retArray) - Application.Min(retArray)) / n
Next i
ReDim helpArray(1 To n)
helpArray(1) = 1

For i = 2 To n
For j = 1 To n
If (retArray(j) >= limitArray(i - 1)) And (retArray(j) < limitArray(i)) Then
helpArray(i) = helpArray(i) + 1
End If
Next j
Next i

ReDim distrArray(1 To n)
For i = 1 To (n)
distrArray(i) = helpArray(i) / n
Next i
ReDim cumDistrArray(1 To n)
cumDistrArray(1) = distrArray(1)
For i = 2 To (n)
cumDistrArray(i) = cumDistrArray(i - 1) + distrArray(i)
Next i
ReDim cumCumArray(1 To n)
cumCumArray(1) = cumDistrArray(1)
For i = 2 To (n)
cumCumArray(i) = cumCumArray(i - 1) + cumDistrArray(i)
Next i
ReDim cum1DistrArray(1 To n)
cum1DistrArray(1) = 1
For i = 2 To (n)
cum1DistrArray(i) = 1 - cumDistrArray(i - 1)
Next i

ReDim cum1CumArray(1 To n)
cum1CumArray(1) = 1
For i = 2 To (n)
cum1CumArray(i) = cum1CumArray(i - 1) + cum1DistrArray(i)
Next i


ReDim helpOmega(1 To n)
helpOmega(1) = 999999
For i = 2 To (n)
helpOmega(i) = (Application.Max(cum1CumArray) - cum1CumArray(i)) / cumCumArray(i)

Next i

For i = 1 To n - 1
If (Threshold >= limitArray(i)) And Threshold < limitArray(i + 1) Then
NewOmega = helpOmega(i + 1)
End If
Next i


Else
If Threshold = Application.Min(retArray) Then
NewOmega = "There is no loss"
Else
If Threshold = Application.Max(retArray) Then
NewOmega = "There is no gain"
Else
NewOmega = ""
End If
End If
End If

End Function


and the second function, using the first one:

Function OmegaOfThreshold(retArray)
Application.Volatile
Dim n As Integer
Dim ThresholdArray
Dim OmegaOfL
n = Application.Count(retArray)
ReDim ThresholdArray(1 To n)
ThresholdArray(1) = Application.Min(retArray)
ThresholdArray(n) = Application.Max(retArray)
For i = 2 To n - 1
ThresholdArray(i) = ThresholdArray(i - 1) + (Application.Max(retArray) - Application.Min(retArray)) / n
Next i
ReDim OmegaOfL(1 To n)
For i = 1 To n
If (NewOmega(retArray, ThresholdArray(i)) = "There is no loss") Or (NewOmega(retArray, ThresholdArray(i)) = "There is no gain") Or (NewOmega(retArray, ThresholdArray(i)) <= 0) Then
OmegaOfL(i) = ""
Else
OmegaOfL(i) = Application.Ln(NewOmega(retArray, ThresholdArray(i)))
End If
Next i
OmegaOfThreshold = Application.Transpose(Array(OmegaOfL))

End Function


The second one makes Excel stop.


Tks,
Maca.

Didn't take the time to look over the whole thing, so I don't know about
functionality. But just glancing over it, a couple of things come to mind:

1) strongly type your variables, i.e., if cumDistrArray holds on strings,
then declare it as a string array: "Dim cumDistrArray as Striing()." Not
typing your variables means that each one is initialized as a Variant type.
Variants are assigned a large amount of memory (don't remember exactly how
many bytes) and when the variable is used for the first time, VBA has to
determine what kind of 'type' it is.

2) All the ReDims are very process intensive. (VBA has to assign a new
block of memory and free up the previous.). Any way you could reduce the
number of them, that would help. Have you considered using collections
instead of arrays? They don't have to be dimensioned. (Excel/VBA pros, feel
free to chime in here, as I don't know what the performance trade-offs would
be, using collections instead of arrays.)

Hope this is helpful.

-EW

"maca" wrote:

>
> Hi ,
> Here the first function (for 300 input cells, it takes almost 30
> seconds).
>
> Function NewOmega(retArray, Threshold)
> Application.Volatile
> Dim n As Integer
> Dim distrArray
> Dim limitArray
> Dim helpArray
> Dim cumDistrArray
> Dim cumCumArray
> Dim cum1DistrArray
> Dim cum1CumArray
> Dim targetArray
> Dim helpOmega
> Dim om As Double
> n = Application.Count(retArray)
> If (Threshold < Application.Max(retArray)) And (Threshold >
> Application.Min(retArray)) Then
> ReDim limitArray(n)
> limitArray(1) = Application.Min(retArray)
> limitArray(n) = Application.Max(retArray)
> For i = 2 To n - 1
> limitArray(i) = limitArray(i - 1) + (Application.Max(retArray)
> - Application.Min(retArray)) / n
> Next i
> ReDim helpArray(1 To n)
> helpArray(1) = 1
>
> For i = 2 To n
> For j = 1 To n
> If (retArray(j) >= limitArray(i - 1)) And (retArray(j) <
> limitArray(i)) Then
> helpArray(i) = helpArray(i) + 1
> End If
> Next j
> Next i
>
> ReDim distrArray(1 To n)
> For i = 1 To (n)
> distrArray(i) = helpArray(i) / n
> Next i
> ReDim cumDistrArray(1 To n)
> cumDistrArray(1) = distrArray(1)
> For i = 2 To (n)
> cumDistrArray(i) = cumDistrArray(i - 1) + distrArray(i)
> Next i
> ReDim cumCumArray(1 To n)
> cumCumArray(1) = cumDistrArray(1)
> For i = 2 To (n)
> cumCumArray(i) = cumCumArray(i - 1) + cumDistrArray(i)
> Next i
> ReDim cum1DistrArray(1 To n)
> cum1DistrArray(1) = 1
> For i = 2 To (n)
> cum1DistrArray(i) = 1 - cumDistrArray(i - 1)
> Next i
>
> ReDim cum1CumArray(1 To n)
> cum1CumArray(1) = 1
> For i = 2 To (n)
> cum1CumArray(i) = cum1CumArray(i - 1) + cum1DistrArray(i)
> Next i
>
>
> ReDim helpOmega(1 To n)
> helpOmega(1) = 999999
> For i = 2 To (n)
> helpOmega(i) = (Application.Max(cum1CumArray) -
> cum1CumArray(i)) / cumCumArray(i)
>
> Next i
>
> For i = 1 To n - 1
> If (Threshold >= limitArray(i)) And Threshold < limitArray(i +
> 1) Then
> NewOmega = helpOmega(i + 1)
> End If
> Next i
>
>
> Else
> If Threshold = Application.Min(retArray) Then
> NewOmega = "There is no loss"
> Else
> If Threshold = Application.Max(retArray) Then
> NewOmega = "There is no gain"
> Else
> NewOmega = ""
> End If
> End If
> End If
>
> End Function
>
>
> and the second function, using the first one:
>
> Function OmegaOfThreshold(retArray)
> Application.Volatile
> Dim n As Integer
> Dim ThresholdArray
> Dim OmegaOfL
> n = Application.Count(retArray)
> ReDim ThresholdArray(1 To n)
> ThresholdArray(1) = Application.Min(retArray)
> ThresholdArray(n) = Application.Max(retArray)
> For i = 2 To n - 1
> ThresholdArray(i) = ThresholdArray(i - 1) +
> (Application.Max(retArray) - Application.Min(retArray)) / n
> Next i
> ReDim OmegaOfL(1 To n)
> For i = 1 To n
> If (NewOmega(retArray, ThresholdArray(i)) = "There is no loss")
> Or (NewOmega(retArray, ThresholdArray(i)) = "There is no gain") Or
> (NewOmega(retArray, ThresholdArray(i)) <= 0) Then
> OmegaOfL(i) = ""
> Else
> OmegaOfL(i) = Application.Ln(NewOmega(retArray,
> ThresholdArray(i)))
> End If
> Next i
> OmegaOfThreshold = Application.Transpose(Array(OmegaOfL))
>
> End Function
>
>
> The second one makes Excel stop.
>
>
> Tks,
> Maca.
>
>
> --
> maca
> ------------------------------------------------------------------------
> maca's Profile: http://www.excelforum.com/member.php...o&userid=24892
> View this thread: http://www.excelforum.com/showthread...hreadid=387489
>
>