Recordset Performance issue 1

[psatyendra]

Hi

I am working on VBA macro's coding for Excel from last 3 months. I did a small reporting project and delivered it to client. I query data from SQL recordsets and displaying it. But it was slow while looping recordset. So copied complete data into variant variable and i loop that variant variable. I feel performance is improved. But when it went to client for beta testing, they raised performance is poor. Is there any way to improve performance.

sample code :

Function RVALUE(account_label As String, time_label As String, entity_label As String, database_label As String, scenario_label As String, analysis_label) As Double

If (ConnectionString <> "") Then
Dim value As String
Dim fval As String
Dim i As Long

Dim dbLbl As String
dbLbl = Replace(Trim(database_label), " ", "_")

If ishsfFinEmpty = True Then
loadDbData ()
End If

For i = 0 To UBound(hsfValueList, 2)
If StrConv(hsfValueList(4, i), vbLowerCase) = StrConv(account_label, vbLowerCase) Then
If StrConv(hsfValueList(1, i), vbLowerCase) = StrConv(ana_label, vbLowerCase) Then
If StrConv(hsfValueList(6, i), vbLowerCase) = StrConv(database_label, vbLowerCase) Then
If StrConv(hsfValueList(2, i), vbLowerCase) = StrConv(entity_label, vbLowerCase) Then
If StrConv(hsfValueList(3, i), vbLowerCase) = StrConv(scenario_label, vbLowerCase) Then
If StrConv(hsfValueList(5, i), vbLowerCase) = time_label Then
value = hsfValueList(0, i)
value = Format(value, "#,###,###,##0.000000")
RVALUE= value
Exit Function
End If
End If
End If
End If
End If
End If
Next
RVALUE = ""
Else
RVALUE = ""
End If
End Function

Public Sub getDBData(database_label As String)
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim cmd As New ADODB.Command

cnt.Open ConnectionString
Set cmd.ActiveConnection = cnt
cmd.CommandText = "Select PFC.DataValue,PAN.AnalysisLabel, PEN.EntityLabel, PSN.ScenarioLabel, PAC.AccountLabel, PTI.Timelabel, PEN.DataBaseName FROM " & database_label & "_fact PFC inner join " & database_label & "_Analysis PAN on PFC.ANALYSISID = PAN.ANALYSISID inner join " & database_label & "_Entity PEN on PFC.EntityID = PEN.EntityID inner join " & database_label & "_Scenario PSN on PFC.ScenarioID = PSN.ScenarioID inner join " & database_label & "_Account PAC on PFC.AccountID = PAC.AccountID inner join " & database_label & "_Time PTI on PFC.TIMEID = PTI.TimeID" & whereString
cmd.CommandType = adCmdText

On Error GoTo EndFun:

cmd.Execute
rst.Open cmd
If Not rst Is Nothing Then
On Error Resume Next

If Not rst.EOF Then
If ishsfFinEmpty = True Then
hsfValueList = rst.GetRows(rst.RecordCount)
Else
Dim i As Integer
Dim j As Integer
Dim colcount As Integer

colcount = rst.Fields.count
i = UBound(hsfValueList, 2)
With rst

Dim valfld As Field
Dim anfld As Field
Dim enfld As Field
Dim scfld As Field
Dim acfld As Field
Dim tpfld As Field
Dim dbfld As Field

valfld = .Fields(0)
anfld = .Fields(1)
enfld = .Fields(2)
scfld = .Fields(3)
acfld = .Fields(4)
tpfld = .Fields(5)
dbfld = .Fields(6)

Do Until .EOF
ReDim Preserve hsfValueList(colcount - 1, i)
'For j = 0 To colcount - 1
' hsfValueList(j, i) = .Fields(j)
'Next
hsfValueList(0, i) = valfld
hsfValueList(1, i) = anfld
hsfValueList(2, i) = enfld
hsfValueList(3, i) = scfld
hsfValueList(4, i) = acfld
hsfValueList(5, i) = tpfld
hsfValueList(6, i) = dbfld

.MoveNext
i = i + 1
Loop
End With
End If
End If
On Error GoTo 0
End If
rst.Close
cnt.Close
Set rst = Nothing
Set cnt = Nothing
GoTo EndFun:
NoDataLable:
MsgBox ("Data not available for database " & database_label)
EndFun:
End Sub

Here "hsfValueList" is variant variable. if we call RVALUE funciton from Excel number of times(Ex:200,000), then this function causes poor performance. In that variant variable contains more then 200,000 records. So i need a solution to solve this.

 

[HarleyQuinn]

I'm going to say all of the string manipulation you do will be causing some of the speed issues.

I'd do it like this:

Convert all of the returned values from the SQL to lowercase within the SQL.

Assign ana_label, database_label, entity_label, scenario_label and time_label to varibles and convert them to lower case once at the start of the function.

Then compare the values. That cuts out an awful lot of string manipulation.

Hope this helps

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[HarleyQuinn]

Sorry, my bad, as I now see that the values I said to to assign to variables are passed parameters, you can skip the bit about assigning them. The bit about converting them once still stands though.

HarleyQuinn
---------------------------------
The most overlooked advantage to owning a computer is that if they foul up there's no law against wacking them around a little. - Joe Martin

Get the most out of Tek-Tips, read FAQ222-2244 before posting.

 

[Golom]

My first reaction is that you have a DBMS and you should be using it. Rather than retrieving everything into a monster-array and iterating through it, just build some SQL and retrieve the record from the DBMS.

Function RVALUE(account_label As String, _
                time_label As String, _
                entity_label As String, _
                database_label As String, _
                scenario_label As String, _
                analysis_label) As Double

    If (ConnectionString <> "") Then
        Dim SQL                     As String
        Dim cnt                     As New ADODB.Connection
        Dim rst                     As New ADODB.Recordset
        Dim cmd                     As New ADODB.Command

        cnt.Open ConnectionString
        Set cmd.ActiveConnection = cnt

        SQL = "Select PFC.DataValue, PAN.AnalysisLabel, PEN.EntityLabel, PSN.ScenarioLabel, " & _
              "PAC.AccountLabel, PTI.Timelabel, PEN.DataBaseName " & _
              " " & _
              "FROM myTable_fact PFC " & _
              "  INNER JOIN myTable_Analysis PAN ON PFC.ANALYSISID = PAN.ANALYSISID " & _
              "  INNER JOIN myTable_Entity PEN   ON PFC.EntityID   = PEN.EntityID " & _
              "  INNER JOIN myTable_Scenario PSN ON PFC.ScenarioID = PSN.ScenarioID " & _
              "  INNER JOIN myTable_Account PAC  ON PFC.AccountID  = PAC.AccountID " & _
              "  INNER JOIN myTable_Time PTI     ON PFC.TIMEID     = PTI.TimeID " & _
              " " & _
              "WHERE PAC.AccountLabel  = '" & account_label & "' " & _
              "  AND PAN.AnalysisLabel = '" & ana_label & "' " & _
              "  AND PEN.DatabaseName  = '" & database_label & "' " & _
              "  AND PEN.EntityLabel   = '" & entity_label & "' " & _
              "  AND PSN.ScenarioLabel = '" & scenario_label & "' " & _
              "  AND PTI.Timelabel     = '" & time_label & "' "

        cmd.CommandType = adCmdText
        cmd.CommandText = SQL
        cmd.Execute
        rst.Open cmd

        If rst.EOF Then
            RVALUE = ""
        Else
            RVALUE = Format(rst![DataValue], "#,###,###,##0.000000")
        End If

        rst.Close
        Set rst = Nothing
        Set cmd = Nothing
        Set cnt = Nothing
    End If

End Function

The above is only a template. You will need to

- use a variable for your table name in place of "myTable" that I used.

- Include your "whereclause" conditions in addition to the ones that are shown here.

 

[psatyendra]

Sorry. This solution doesn't work for me. Because i need to call RValue function more then 4000 times. So every time, if we call database is not a fair idea. I tried this solution, But i found bitter performance issue. Can anyone help me to solve this. I think, is there any solution to use pivot tables to solve my problem. Thanks for your valuable support.

 

[PHV]

You may consider a Scripting.Dictionary object:

http://msdn.microsoft.com/en-us/library/x4k5wbx4(VS.85).aspx

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[Golom]

Very good PHV!

In some testing

ADO takes 72 seconds for 4000 iterations
DAO takes 36 seconds
A dictionary object takes 0.9 seconds!