How to speed up the code??

[Punar]

I have a macro which runs the same thing 1000 times with change in the inputs. Here's the code:

Sub valgen()

Application.Screenupdating = False

Dim RateArr(), DfArr() As Double
Dim TempArr1(), TempArr2() As Variant
Dim i As Integer

ReDim RateArr(1 To 50, 1 To 77)
ReDim DfArr(1 To 50, 1 To 154)
ReDim TempArr1(1 To 50)
ReDim TempArr2(1 To 50)

For i = 2 To 1000
Range("C1195").Select
ActiveCell.Offset(4 * (i - 2), 0).Select
ActiveCell.Value = "SCENARIO" & " " & i


Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 78)).Value = Range(ActiveCell.Offset((-3 * i - 1114), 2), ActiveCell.Offset((-3 * i - 1114), 78)).Value
RateArr = forwardlibor(Range("D5", "CB64"), Range("A1079", "A1128"), Range("B1079", "B1128"), Range("D1078", "CB1078"), 1, Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 78)))
DfArr = CurveGen(Range("D1078", "CB1078"), RateArr)
'Range(ActiveCell.Offset(2, 1), ActiveCell.Offset(52, 155)).Value
For j = 1 To 77
TempArr1 = Application.Index(DfArr, 0, (2 * j - 1))
TempArr2 = Application.Index(DfArr, 0, 2 * j)

ActiveCell.Offset(2, j - 1).Value = FIXLEG(Range("B1162").Value, Range("B1164").Value, Range("B1165").Value, Range("B1166").Value, Range("B1167").Value, Range("B1168").Value, TempArr1, TempArr2) - FLTLEG(Range("B1178").Value, Range("B1179").Value, Range("B1180").Value, Range("B1181").Value, Range("B1182").Value, Range("B1183").Value, Range("B1184").Value, TempArr1, TempArr2)
Next
Next

Application.Screenupdating = True

End Sub

​

It is taking around 20 minutes to run! Is there a way to speed it up??

 

[Andrew Poulsom]

To get help you will need to post your functions forwardlibor, CurveGen, FIXLEG and FLTLEG.

 

[Punar]

Hi Andrew,

These are quite complex functions. Without changing them much, is there anything that can be done?
What I am basically doing is that I have a set of data on the sheet which I take as the input and pass it to the function forwardlibor. It gives me back an intermediate output which is stored in an array(RateArr) and then passed on to the next function(Curvegen), the ouput of which is again stored in another array(DfArr). Now I need to give the the input column by column into the functions FIXLEG and FLTLEG. For that I have used the second loop.

I do not need the intermediate results after I get the final output in each run of the loop. So, I am overwriting the next data into the same arrays hoping to increase the speed. Alternatively I tried dumping the intermediate outputs on the sheet and saving nothing at all. But that also takes almost same amount of time.

Should I post all these functions?

 

[Andrew Poulsom]

I imagine that it's the functions that are taking the time.

 

[Punar]

I'll post them one by one here then. Here is forwardlibor:

Public Function forwardlibor(incremental_variance As Variant, tenor As Variant, libor_rates As Variant, horizondate As Variant, Opt As Integer, Optional random_numbers As Variant)
Dim l() As Double, i As Integer, k As Integer, temp() As Double, forward_libor() As Double, j As Integer, m As Double

NoOfTenor = tenor.Rows.Count
NoOfHD = incremental_variance.Columns.Count
ReDim l(1 To NoOfTenor, 1 To NoOfHD)
ReDim temp(1 To NoOfHD + 1, 1 To 2)
ReDim forward_libor(1 To NoOfTenor, 1 To NoOfHD)
'for Horizon date = 0
For j = 1 To NoOfTenor
l(j, 1) = libor_rates(j)

Next


For i = 2 To NoOfHD
' generate random numbers, if they have not been defined in the input
'If IsMissing(random_numbers) Then
'x = RandomNumbers(0, 1, 9)
'r = WorksheetFunction.NormSInv(x)
'Else
r = random_numbers(i - 1)
'End If

For j = 1 To NoOfTenor

m = (Exp((-0.5 * incremental_variance(j, i)) + ((incremental_variance(j, i) ^ 0.5) * r)))
l(j, i) = l(j, i - 1) * m

Next
Next
' generates an array "temp", which holds the forward libor rate as well as the corresponding tenor for all horizon
' dates
For i = 1 To NoOfHD
For k = 1 To NoOfTenor

If (horizondate(i) <= tenor(k)) Then
' column 1 holds the forward libor
temp(i, 1) = l(k, i)
' column 2 holds the corresponding tenor
temp(i, 2) = tenor(k)
Exit For

End If

Next

Next
' generates the forward curve for each horizon date
For i = 1 To NoOfHD

m = 1
For j = 1 To NoOfTenor

For k = m To NoOfHD

If (horizondate(i) <= temp(k, 2)) Then
'parses through the temp array, to find the forward libor rate for each tenor
If (temp(k, 2) <> temp(k + 1, 2)) Then
forward_libor(j, i) = temp(k, 1)
'm holds the current position of k, so that the loop need not re-start from the beginning
m = k + 1
Exit For
End If
End If

Next

Next

Next
If (Opt = 1) Then
forwardlibor = l
Else
forwardlibor = forward_libor
End If

End Function

 

[Punar]

CurveGen

Public Function CurveGen(HDates As Variant, Libor() As Double) As Variant
Dim DF() As Double
Dim i As Integer, j As Integer, r As Integer, c As Integer, l As Double, x As Integer
r = 50
c = 77
x = 2 * c
ReDim DF(0 To r, 1 To x)
For i = 1 To x
DF(0, i) = 1
l = i Mod 2
For j = 1 To r
If l <> 0 Then
DF(0, i) = HDates((i + 1) / 2)
DF(j, i) = DateAdd("m", 6, DF(j - 1, i))
Else
DF(j, i) = DF(j - 1, i) / ((Libor(j, i / 2) * NoOfDays(j, 50) / 360) + 1)
End If
Next j
Next i
CurveGen = DF
End Function

 

[Punar]

The remaining functions FIXLEG and FLTLEG are dependant on another set of 5-6 functions. I guess I'll have to look into each of these functions and optimize them. But is it okay to take so much time even if there are so many functions?

 

[Andrew Poulsom]

There are a lot of loops within loops there, so I would expect it to take some time.

 

[Punar]

I agree.
Thanks a lot for your time Andrew!