Hi,
I have written a Subroutine in VBA 7 for Access 2010 that implements a recursive formula. In Excel the formula looks something like this:
Where the formula is applied for cells of column E
The subroutine that I have written in Access works fine but is too slow. My table has about 100,000 records but the subroutine takes about 4-5 minutes even when I process only 500 records.
No need to say that I am a newbie in Visual Basic and programming is not one of my strongest skills. The code is probably not well written and I am hoping that some of you could provide suggestions to improve it!
Thanks
I have written a Subroutine in VBA 7 for Access 2010 that implements a recursive formula. In Excel the formula looks something like this:
Code:
=IF(MONTH(B2)=1,100*(1+C2/D2),E1*(1+C2/D2))Where the formula is applied for cells of column E
The subroutine that I have written in Access works fine but is too slow. My table has about 100,000 records but the subroutine takes about 4-5 minutes even when I process only 500 records.
No need to say that I am a newbie in Visual Basic and programming is not one of my strongest skills. The code is probably not well written and I am hoping that some of you could provide suggestions to improve it!
Thanks
Code:
Sub Test_Calculation()
Dim curDatabase As Database
Dim tbl As TableDef
Dim FieldName As Field
Dim x As Double
Dim y As Double
Dim z As Double
Dim num As Double
Dim den As Double
Dim num_mbefore As Double
Dim den_mbefore As Double
Dim month_before As String
Dim cur_asset As String
Dim CurMonth As Integer
Dim Year As Integer
Dim a As Integer
Dim b As String
Dim Rst As DAO.Recordset
Dim Rst2 As DAO.Recordset
Dim fld As DAO.Field
Dim tdef As DAO.TableDef
' Get a reference to the current database
Set curDatabase = CurrentDb
Set tdef = curDatabase.TableDefs("IPD_asset")
'Create the field CalcTest or clean it if it exists
a = 0
For Each fld In tdef.Fields
If fld.Name = "CalcTest" Then
CurrentDb.Execute "UPDATE IPD_asset SET CalcTest = Null", dbFailOnError
a = a + 1
End If
Next
If a < 1 Then
curDatabase.Execute "ALTER TABLE IPD_asset ADD COLUMN CalcTest Double"
End If
'Select subset of table between two dates and order it (filter)
Set Rst = CurrentDb.OpenRecordset("SELECT * FROM IPD_asset Where Month Between #01/01/1990# and #01/01/1991# Order By Month ")
If Not (Rst.EOF And Rst.BOF) Then
Rst.MoveFirst
Do Until Rst.EOF = True
If Month(Rst.Fields("Month").Value) = 1 Then
num = Rst.Fields("Total Return Num")
den = Rst.Fields("TR/IR/CG Den")
If den = 0 Then
x = 0
Else
x = num / den
x = x + 1
x = 100 * x
End If
Rst.Edit
Rst.Fields("CalcTest") = x
Rst.Update
Else
'Parses the date to get the previous months date
Year = DatePart("yyyy", Rst.Fields("Month"))
CurMonth = Month(Rst.Fields("Month"))
cur_asset = Rst.Fields("IPD Ref").Value
CurMonth = CurMonth - 1
month_before = "#" + CStr(CurMonth) + "/1/" + CStr(Year) + "#"
'here we select the calculated value for the previous month and the correct IPD ref
Set Rst2 = CurrentDb.OpenRecordset("SELECT * FROM IPD_asset WHERE Month =" & month_before & " AND [IPD Ref]='" & cur_asset & "'")
If Not (Rst2.EOF And Rst2.BOF) Then
z = Rst2.Fields("CalcTest")
'Current month Calculations with the Calculted Value from the previous month
num = Rst.Fields("Total Return Num")
den = Rst.Fields("TR/IR/CG Den")
If den = 0 Then
y = 0
Else
y = num / den
y = y + 1
y = z * y
End If
Else
y = num / den
y = y + 1
y = 100 * y
End If
Rst.Edit
Rst.Fields("CalcTest") = y
Rst.Update
End If
Rst.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
Cleanup:
Rst.Close
Set Rst = Nothing
Rst2.Close
Set Rst2 = Nothing
End Sub
