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

--
mac
-----------------------------------------------------------------------
maca's Profile: http://www.excelforum.com/member.php...fo&userid=2489
View this thread: http://www.excelforum.com/showthread.php?threadid=38748

post your macro's

then I will look at the

--
Kaa
-----------------------------------------------------------------------
Kaak's Profile: http://www.excelforum.com/member.php...nfo&userid=751
View this thread: http://www.excelforum.com/showthread.php?threadid=38748

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

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