Using Array to store calculations in VBA

Question

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:

Dim results() as variant
Redim results(I,j)
Results (I,j)= q
Range("G5").value=results

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.

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 Sub

• Raystafarian: To address using an array - basically from what I can tell is that you have two tables of actuarial data points - one for men and one for women. Those are constant. Then you have a range on the other sheet with gender and date of birth. And you want to look each of those people up in one of the tables, right?
• SRS: @Raystafarian well spotted, it is an actuarial model that I am working on. So, I have one list of Males and Females, with their respective dates of birth/ages on one tab. On another tab, I have mortality rates for males, and on another tab mortality rates for females. So my code is supposed to circulate through each person, identify gender and age and apply mortality rates at each future time period. Sorry if that is a little unclear. I guess it would be useful for me to understand in general how a calculation carried out in vba can be stored in an array and then dumped into a worksheet. PS: t

Answer 1

it is an actuarial model that I am working on. So, I have one list of Males and Females, with their respective dates of birth/ages on one tab. On another tab, I have mortality rates for males, and on another tab mortality rates for females. So my code is supposed to circulate through each person, identify gender and age and apply mortality rates at each future time period. Sorry if that is a little unclear. I guess it would be useful for me to understand in general how a calculation carried out in vba can be stored in an array and then dumped into a worksheet.

All right, to address that, what I would do is make a dictionary out of the two actuarial tables on the male worksheet and female worksheet.

Then create an array of the data you want to populate, and look it up in whatever dictionary is the correct one.

Without understanding exactly how your table is set up, I can only offer this example -

Option Explicit
Public Sub ArrayLookupAndPopulate()
 Dim firstTable As Object
 Set firstTable = CreateObject("Scripting.Dictionary")
 Dim secondTable As Object
 Set secondTable = CreateObject("Scripting.Dictionary")
 Dim rowNumber As Long
 Dim myKey As String
 Dim lookupArray As Variant
 Dim myIndex As Long
 For rowNumber = 1 To 10
 firstTable.Add CStr(Sheet1.Cells(rowNumber, 1)), Sheet1.Cells(rowNumber, 3)
 secondTable.Add CStr(Sheet2.Cells(rowNumber, 1)), Sheet2.Cells(rowNumber, 3)
 Next
 Dim lastRow As Long
 lastRow = Sheet3.Cells(Rows.Count, "A").End(xlUp).Row
 Dim lastColumn As Long
 lastColumn = Sheet3.Cells(1, Columns.Count).End(xlToLeft).Column + 1
 ReDim lookupArray(1 To lastRow, 1 To lastColumn)
 lookupArray = Sheet3.Range(Cells(1, 1), Cells(lastRow, lastColumn))
 For myIndex = 1 To 9
 myKey = lookupArray(myIndex, 2)
 If lookupArray(myIndex, 1) = "First" Then lookupArray(myIndex, 3) = firstTable.Item(myKey)
 If lookupArray(myIndex, 1) = "Second" Then lookupArray(myIndex, 3) = secondTable.Item(myKey)
 Next
 Sheet3.Range("F1:H9") = lookupArray
End Sub

You just need to adjust the names and the ranges because I was working with something static.

I posted this for review Creating two dictionaries to lookup values into an array

• Raystafarian: You might need to not use dictionaries if your lookup data is more than two columns, but I don't think it is. You can expand the array to fit your entire table though

Answer 2

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 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 Sub

---

Next, 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 Sub

This If block can be simplified

 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

Into

 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 If

---

This piece

ActiveSheet.Range("F5", Range("F5").End(xlDown)).Count

Is 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 lastColumn

---

Eh, that's it for now from me.