Excel VBA function with Recordset (Performance issue)

Question

I have a database in SQL Server that I'm using to feed some financial reports in Excel. I'm using Recordsets through a custom Excel Function that uses arguments from Cells to build the SQL queries. Here is how the code looks:

 Public Function Test(arg1 As String, arg2 As String, arg3 As Integer, arg4 As Integer, arg5 As String) As Variant
    Dim oConnection As ADODB.Connection
    Set oConnection = New ADODB.Connection
    Dim oRecordset As ADODB.Recordset
    Set oRecordset = New ADODB.Recordset

    Dim strSQL As String

    strSQL = "SELECT SUM(BALANCE) as Total FROM Accounting WHERE ARGUMENT1 = " & Chr$(39) & arg1 & Chr$(39) & " AND ARGUMENT2 = " & Chr$(39) & arg2 & Chr$(39) & " AND ARGUMENT3 = " & Chr$(39) & arg3 & Chr$(39) & " AND ARGUMENT4 = " & arg4 & "  AND ARGUMENT5 = " & arg5 & ""

    oConnection.Open "Provider=SQLOLEDB;" & _
                         "Data Source=(IP of database);" & _
                         "Initial Catalog=(catalog of database);" & _
                         "Trusted_connection=yes;"

    oRecordset.Open Source:=strSQL, ActiveConnection:=oConnection, CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly, Options:=adCmdText


    Test = oRecordset!Total

        oRecordset.Close
        Set oRecordset = Nothing


End Function

So, this code works very well but I'm having a performance issue. I have to fill dozens of cells, and each cell uses different arguments coming from different cells. So I have reports that take over 1 minute to load fully.

I'm using adOpenForwardOnly, but are there any other fine tunings I can do to the code to speed up things?

Thank you very much

Answer 1

If your data is not particularly time-sensitive then you can "memoize" your UDF by having it cache previously-queried results using a dictionary object.

Untested:

Public Function Test(arg1 As String, arg2 As String, arg3 As Integer, _
                            arg4 As Integer, arg5 As String) As Variant
    
    Static dict As Object   'maintained between calls
    Dim k As String, rv
    Dim oConnection As ADODB.Connection
    Dim oRecordset As ADODB.Recordset
    Dim strSQL As String

    'create the dictionary if not already created
    If dict Is Nothing Then
        Set dict = CreateObject("scripting.dictionary")
    End If
    
    'create a unique "key" from the arguments
    k = Join(Array(arg1, arg2, arg3, arg4, arg5), Chr(0))
    
    'need to run this query?
    If Not dict.exists(k) Then
    
        Set oConnection = New ADODB.Connection
        Set oRecordset = New ADODB.Recordset
        
        strSQL = "SELECT SUM(BALANCE) as Total FROM Accounting WHERE ARGUMENT1 = '" & _
                 arg1 & "' AND ARGUMENT2 = '" & arg2 & _
                 "' AND ARGUMENT3 = '" & arg3 & "' AND ARGUMENT4 = " & arg4 & _
                 "  AND ARGUMENT5 = " & arg5 & ""
    
        oConnection.Open "Provider=SQLOLEDB;" & _
                             "Data Source=(IP of database);" & _
                             "Initial Catalog=(catalog of database);" & _
                             "Trusted_connection=yes;"
    
        oRecordset.Open Source:=strSQL, ActiveConnection:=oConnection, _
                        CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly, _
                        Options:=adCmdText
    
    
        rv = oRecordset!Total
    
        dict.Add k, rv
        
        oRecordset.Close
        Set oRecordset = Nothing
    
    Else
        'already ran the SQL - just return the result
        rv = dict(k)
    End If

    Test = rv
    
End Function