How to speed up the code??

Punar

New Member
Joined
Jul 10, 2012
Messages
8
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??
 
Last edited:

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
To get help you will need to post your functions forwardlibor, CurveGen, FIXLEG and FLTLEG.
 

Punar

New Member
Joined
Jul 10, 2012
Messages
8
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?
 

Punar

New Member
Joined
Jul 10, 2012
Messages
8

ADVERTISEMENT

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

New Member
Joined
Jul 10, 2012
Messages
8
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

New Member
Joined
Jul 10, 2012
Messages
8

ADVERTISEMENT

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?
 

Watch MrExcel Video

Forum statistics

Threads
1,122,472
Messages
5,596,353
Members
414,060
Latest member
hermanseck

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top