patternMinor
Using Array to store calculations in VBA
Viewed 0 times
arraystorecalculationsusingvba
Problem
I have the following VBA code, which works perfectly well to calculate "q"
However, the code is very slow and that is due to the large number of q's being calculated (roughly 7.2m q's are being calculated).
So I thought the best way to proceed is to try store the calculated q values in an array and then dump them into the spreadsheet once all of them are calculated.
The q's will vary for each i and j combination. I have tried to add the following to try and store results in an array to the to the main code given below:
This did not work and I know it does not even look half right, but if you could help me spot where I am going wrong it would be really appreciated.
However, the code is very slow and that is due to the large number of q's being calculated (roughly 7.2m q's are being calculated).
So I thought the best way to proceed is to try store the calculated q values in an array and then dump them into the spreadsheet once all of them are calculated.
The q's will vary for each i and j combination. I have tried to add the following to try and store results in an array to the to the main code given below:
Dim results() as variant
Redim results(I,j)
Results (I,j)= q
Range("G5").value=resultsThis did not work and I know it does not even look half right, but if you could help me spot where I am going wrong it would be really appreciated.
Sub mort()
Dim age As Integer
Dim month As Integer
For i = 0 To ActiveSheet.Range("F5", Range("F5").End(xlDown)).Count
For j = 0 To ActiveSheet.Range("G3", Range("G3").End(xlToRight)).Count
gender = Range("C5").Offset(i, 0)
If gender = "F" Then
mortable = Worksheets("Female Tabs").Range("A3:C122")
Else
mortable = Worksheets("Male Tabs").Range("A3:C122")
End If
month = Range("G3").Offset(0, j)
age = WorksheetFunction.RoundDown(Range("F5").Offset(i, 0) + (month - 3) / 12, 0)
If age < 119 Then
a = (12 - ((month - 3) Mod 12)) / 12
a1 = Application.VLookup(age, mortable, 3, False)
b = ((month - 3) Mod 12) / 12
b1 = Application.VLookup(age + 1, mortable, 3, False)
Else
a1 = 0
b1 = 0
End If
q = (1 / 12) * (a * a1 + b * b1)
Worksheets("Policy Mortality Qx").Range("G5").Offset(i, j).Value = q
Next j
Next i
End SubSolution
Most of your variables aren't defined and your indenting isn't great.
When you don't define your variable, VBA will declare it as a Variant, which are objects:
Performance. A variable you declare with the Object type is flexible
enough to contain a reference to any object. However, when you invoke
a method or property on such a variable, you always incur late binding
(at run time). To force early binding (at compile time) and better
performance, declare the variable with a specific class name, or cast
it to the specific data type.
By not declaring variables, you could possibly be paying a penalty.
It's good practice to indent all of your code that way
Here's the first thing I would do -
Next, I'd deal with the Variable names - give your variables meaningful names. As well as your procedure
Also if
This
Into
This piece
Is not the best way to find the bottom of a range
Eh, that's it for now from me.
When you don't define your variable, VBA will declare it as a Variant, which are objects:
Performance. A variable you declare with the Object type is flexible
enough to contain a reference to any object. However, when you invoke
a method or property on such a variable, you always incur late binding
(at run time). To force early binding (at compile time) and better
performance, declare the variable with a specific class name, or cast
it to the specific data type.
By not declaring variables, you could possibly be paying a penalty.
It's good practice to indent all of your code that way
Labels will stick out as obvious.Here's the first thing I would do -
Option Explicit
Sub mort()
Dim age As Integer
Dim month As Integer
Dim i As Long
Dim j As Long
Dim gender As String
Dim mortable As String
Dim a As Long
Dim b As Long
Dim a1 As Long
Dim b1 As Long
Dim q As Long
For i = 0 To ActiveSheet.Range("F5", Range("F5").End(xlDown)).Count
For j = 0 To ActiveSheet.Range("G3", Range("G3").End(xlToRight)).Count
gender = Range("C5").Offset(i, 0)
If gender = "F" Then
mortable = Worksheets("Female Tabs").Range("A3:C122")
Else: mortable = Worksheets("Male Tabs").Range("A3:C122")
End If
month = Range("G3").Offset(0, j)
age = WorksheetFunction.RoundDown(Range("F5").Offset(i, 0) + (month - 3) / 12, 0)
If age < 119 Then
a = (12 - ((month - 3) Mod 12)) / 12
a1 = Application.VLookup(age, mortable, 3, False)
b = ((month - 3) Mod 12) / 12
b1 = Application.VLookup(age + 1, mortable, 3, False)
Else
a1 = 0
b1 = 0
End If
q = (1 / 12) * (a * a1 + b * b1)
Worksheets("Policy Mortality Qx").Range("G5").Offset(i, j).Value = q
Next j
Next i
End SubNext, I'd deal with the Variable names - give your variables meaningful names. As well as your procedure
Also if
mortable is a Range then mortable = Worksheets("Female Tabs").Range("A3:C122") needs to be Set mortable = Worksheets("Female Tabs").Range("A3:C122")Private Sub mortable()
Dim age As Long
Dim month As Long
Dim gender As String
Dim mortable
Dim i As Long
Dim j As Long
Dim ageMonths As Long
Dim ageMonthsLookup As Long
Dim ageMonthsIncrease As Long
Dim ageMonthsIncreaseLookup As Long
Dim calculation As Long
End SubThis
If block can be simplifiedIf age < 119 Then
a = (12 - ((month - 3) Mod 12)) / 12
a1 = Application.VLookup(age, mortable, 3, False)
b = ((month - 3) Mod 12) / 12
b1 = Application.VLookup(age + 1, mortable, 3, False)
Else
a1 = 0
b1 = 0
End IfInto
If age < 119 Then
ageMonths = (12 - ((month - 3) Mod 12)) / 12
ageMonthsLookup = Application.VLookup(age, mortable, 3, False)
ageMonthsIncrease = ((month - 3) Mod 12) / 12
ageMonthsIncreaseLookup = Application.VLookup(age + 1, mortable, 3, False)
calculation = (1 / 12) * (a * a1 + b * b1)
Else: calculation = 0
End IfThis piece
ActiveSheet.Range("F5", Range("F5").End(xlDown)).CountIs not the best way to find the bottom of a range
Dim lastRow As Long
Dim lastColumn As Long
lastRow = Cells(Rows.Count, "F").End(xlUp).Row
lastColumn = Cells(3, Columns.Count).End(xlToLeft).Column
For i = 0 To lastRow
For j = 0 To lastColumnEh, that's it for now from me.
Code Snippets
Option Explicit
Sub mort()
Dim age As Integer
Dim month As Integer
Dim i As Long
Dim j As Long
Dim gender As String
Dim mortable As String
Dim a As Long
Dim b As Long
Dim a1 As Long
Dim b1 As Long
Dim q As Long
For i = 0 To ActiveSheet.Range("F5", Range("F5").End(xlDown)).Count
For j = 0 To ActiveSheet.Range("G3", Range("G3").End(xlToRight)).Count
gender = Range("C5").Offset(i, 0)
If gender = "F" Then
mortable = Worksheets("Female Tabs").Range("A3:C122")
Else: mortable = Worksheets("Male Tabs").Range("A3:C122")
End If
month = Range("G3").Offset(0, j)
age = WorksheetFunction.RoundDown(Range("F5").Offset(i, 0) + (month - 3) / 12, 0)
If age < 119 Then
a = (12 - ((month - 3) Mod 12)) / 12
a1 = Application.VLookup(age, mortable, 3, False)
b = ((month - 3) Mod 12) / 12
b1 = Application.VLookup(age + 1, mortable, 3, False)
Else
a1 = 0
b1 = 0
End If
q = (1 / 12) * (a * a1 + b * b1)
Worksheets("Policy Mortality Qx").Range("G5").Offset(i, j).Value = q
Next j
Next i
End SubPrivate Sub mortable()
Dim age As Long
Dim month As Long
Dim gender As String
Dim mortable
Dim i As Long
Dim j As Long
Dim ageMonths As Long
Dim ageMonthsLookup As Long
Dim ageMonthsIncrease As Long
Dim ageMonthsIncreaseLookup As Long
Dim calculation As Long
End SubIf age < 119 Then
a = (12 - ((month - 3) Mod 12)) / 12
a1 = Application.VLookup(age, mortable, 3, False)
b = ((month - 3) Mod 12) / 12
b1 = Application.VLookup(age + 1, mortable, 3, False)
Else
a1 = 0
b1 = 0
End IfIf age < 119 Then
ageMonths = (12 - ((month - 3) Mod 12)) / 12
ageMonthsLookup = Application.VLookup(age, mortable, 3, False)
ageMonthsIncrease = ((month - 3) Mod 12) / 12
ageMonthsIncreaseLookup = Application.VLookup(age + 1, mortable, 3, False)
calculation = (1 / 12) * (a * a1 + b * b1)
Else: calculation = 0
End IfActiveSheet.Range("F5", Range("F5").End(xlDown)).CountContext
StackExchange Code Review Q#127972, answer score: 2
Revisions (0)
No revisions yet.