Excel slows down on loading data from the server

[CaptainD]

I have an excel spreadsheet that downloads data from a MSSQL server. The data is grouped and a sub total done in VBA with a do while not rs.eof, loop
After the worksheet is populated with the recordset data (450 records) the recordset is set to nothing.

The problem I'm having is after about three or four refreshes (running the macro that gets the data) sometimes 6, the worksheet gets noticably slow on populating the worksheet. If I close the file and re-open it, it's fast again. The adodb recordset gets it's data through a stored procedure and that is real fast so the slow down is with excel.

Does anyone have an idea why it would slow down?

 

[Ed2020]

Can you post the code you're running?

Ed Metcalfe.

Please do not feed the trolls.....

 

[CaptainD]

The code connects to an MSSQL server 2000 database

Here is the connection module

Function GetADORSP(strSql As String) As ADODB.Recordset
On Error GoTo Err_GetADORSP

Dim objConn As ADODB.Connection


Set objConn = New ADODB.Connection
objConn.Open "Provider=sqloledb.1;data source=clovis-003;Initial catalog=" & UseDatabase & ";Integrated Security=SSPI;"

Set GetADORSP = New ADODB.Recordset
GetADORSP.Open strSql, objConn, adOpenStatic, adLockReadOnly

Exit Function
Err_GetADORSP:
MsgBox "Error getting data, error #" & Err.Number & ", " & Err.Description

End Function

Here is the getData module

Sub GetData()
On Error GoTo ErrHandler
Dim rs As ADODB.Recordset
Dim strSql As String
Dim i As Integer
Dim StartCell As String
Dim EndCell As String
Dim iColorIndex As Integer
Dim GroupStart As Integer ' Place holder for rows for grouping
Dim GroupEnd As Integer 'Place holder for last row in group
Dim SubTotal1 As Currency
Dim SubTotal2 As Currency
Dim SubTotal3 As Currency
Dim LastCellValue1 As Currency 'Requested Amount last value holder
Dim LastCellValue2 As Currency 'Prelim amount last value holder
Dim lastCellValue3 As Currency 'Approved amount last value holder

'First, make the connection prior to clearing the data
'that way if there is an error the previous data stays
bLoading = True
strSql = "EXEC spGetExcelData"
Set rs = GetADORSP(strSql)


'If no error then your here so lets clear the Worksheet

With Sheet3
.Cells.EntireRow.Ungroup 'Release the groupings
.Range("A:M").Clear 'Clear the data

With .Range("A1:K1")
.Select
.Interior.ColorIndex = 15
.Borders.LineStyle = xlContinuous
.Borders.Weight = xlThin
End With
' With .Range("B:B").Validation
' .Add xlValidateList, xlAlertStop, xlSource = "=CFDAccounts"
'
' .InCellDropdown = True
' End With
End With
i = 1
iColorIndex = 35
strSql = "EXEC spGetExcelData"

Set rs = GetADORSP(strSql)
'Set the Titles
Sheet3.Cells(i, 1) = "Form"
'Set the first rows Color

Sheet3.Cells(i, 2) = "Account"
Sheet3.Cells(i, 3) = "Total Requested"
Sheet3.Cells(i, 4) = "Prelim Amount" 'Added at the request of Chief Aston
Sheet3.Cells(i, 5) = "Amount Approved"
Sheet3.Cells(i, 6) = "Comments"
Sheet3.Cells(i, 7) = "Manager"
Sheet3.Cells(i, 8) = "Supervisor"
Sheet3.Cells(i, 9) = "Item Requested"
Sheet3.Cells(i, 10) = "Requested By"
Sheet3.Cells(i, 11) = "ID Number"
i = i + 1 'i should = 2 at this point
GroupStart = i ' Should be started at 2 where first data entry is located

Do While Not rs.EOF
Sheet3.Cells(i, 1) = rs.Fields("Form").Value
Sheet3.Cells(i, 2) = rs.Fields("Account").Value
Sheet3.Cells(i, 3) = rs.Fields("Total Requested").Value
LastCellValue1 = IIf(IsNull(rs.Fields("Total Requested").Value), 0, rs.Fields("Total Requested").Value)
Sheet3.Cells(i, 4) = rs.Fields("cPrelimAmount").Value
LastCellValue2 = IIf(IsNull(rs.Fields("cPrelimAmount").Value), 0, rs.Fields("cPrelimAmount").Value)
Sheet3.Cells(i, 5) = rs.Fields("Amount Approved").Value
lastCellValue3 = IIf(IsNull(rs.Fields("Amount Approved").Value), 0, rs.Fields("Amount Approved").Value)
Sheet3.Cells(i, 6) = rs.Fields("sApprovalComment").Value
Sheet3.Cells(i, 7) = rs.Fields("Manager").Value
Sheet3.Cells(i, 8) = rs.Fields("Supervisor").Value
Sheet3.Cells(i, 9) = Trim(rs.Fields("Item Requested").Value)
Sheet3.Cells(i, 10) = rs.Fields("Requested By").Value
Sheet3.Cells(i, 11) = rs.Fields("ID").Value
rs.MoveNext
'If the account number changes then we add a total below the previous
'group and drop down one the start the next group

If Not rs.EOF = True Then
If Trim(rs.Fields("Account")) = Trim(Sheet3.Cells(i, 2)) Then 'Same Account number
SubTotal1 = SubTotal1 + Sheet3.Cells(i, 3)
SubTotal2 = SubTotal2 + Sheet3.Cells(i, 4)
SubTotal3 = SubTotal3 + Sheet3.Cells(i, 5)
Else
GroupEnd = i
i = i + 1
StartCell = "A" & i
EndCell = "K" & i
With Sheet3.Range(StartCell, EndCell)
.Select
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = iColorIndex
.EntireRow.Locked = True
End With
'Set the group

Sheet3.Rows(GroupStart & ":" & GroupEnd).Rows.Group
Sheet3.Cells(i, 1) = Sheet3.Cells(i - 1, 2)
Sheet3.Cells(i, 2) = "Sub Total"
Sheet3.Cells(i, 3).Formula = "=Sum($c" & GroupStart & ":$c" & GroupEnd & ")"
'Sheet3.Cells(i, 3) = SubTotal1 + LastCellValue1
Sheet3.Cells(i, 4).Formula = "=Sum($d" & GroupStart & ":$d" & GroupEnd & ")"
'Sheet3.Cells(i, 4) = SubTotal2 + LastCellValue2
Sheet3.Cells(i, 5).Formula = "=Sum($e" & GroupStart & ":$e" & GroupEnd & ")"
SubTotal1 = 0
SubTotal2 = 0
SubTotal3 = 0
LastCellValue1 = 0
LastCellValue2 = 0
lastCellValue3 = 0
GroupStart = i + 1 'Start group at next row
End If
Else
GroupEnd = i
Sheet3.Rows(GroupStart & ":" & GroupEnd).Rows.Group
StartCell = "A" & i + 1
EndCell = "K" & i + 1
With Sheet3.Range(StartCell, EndCell)
.Select
.Borders.LineStyle = xlContinuous
.Interior.ColorIndex = iColorIndex
End With
Sheet3.Range("$B" & GroupStart & ":" & "$B" & GroupEnd).Validation.Add xlValidateList, , , "=CFDAccounts"
Sheet3.Range("$B" & GroupStart & ":" & "$B" & GroupEnd).Validation.InCellDropdown = True
Sheet3.Range("$G" & GroupStart & ":" & "$G" & GroupEnd).Validation.Add xlValidateList, , , "=Supervisors"
Sheet3.Range("$G" & GroupStart & ":" & "$G" & GroupEnd).Validation.InCellDropdown = True
Sheet3.Range("$H" & GroupStart & ":" & "$H" & GroupEnd).Validation.Add xlValidateList, , , "=Managers"
Sheet3.Range("$H" & GroupStart & ":" & "$H" & GroupEnd).Validation.InCellDropdown = True

Sheet3.Cells(i + 1, 1) = Sheet3.Cells(i - 1, 2)
Sheet3.Cells(i + 1, 2) = "Sub Total"
Sheet3.Cells(i + 1, 3).Formula = "=Sum($c" & GroupStart & ":$c" & GroupEnd & ")"
'Sheet3.Cells(i + 1, 3) = SubTotal1 + LastCellValue1
Sheet3.Cells(i + 1, 4).Formula = "=Sum($d" & GroupStart & ":$d" & GroupEnd & ")"
'Sheet3.Cells(i + 1, 4) = SubTotal2 + LastCellValue2
Sheet3.Cells(i + 1, 5).Formula = "=Sum($e" & GroupStart & ":$e" & GroupEnd & ")"
End If
i = i + 1
Loop

'Sheet3.Range("A:h").Ungroup

'Move to the first record
Sheet3.Range("A2").Activate
Set rs = Nothing
bLoading = False
Exit Sub
ErrHandler:

MsgBox "Error loading data, error # " & Err.Number & ", " & Err.Description, vbOKOnly, "Error"
Set rs = Nothing
End Sub

 

[JerryKlmns]

CaptainD
Outside the loop you should close first the rs and then destroy it. And I can't seen anywhere closing the connection and destroying it. You let it loose scope and expect to vanish?
If you need the connection opened then before reopening a new one try to check if it is alive

Dim objConn As ADODB.Connection

If Not objConn Is Nothing Then  ' It is something ....
   If objConn.State=adStateOpen Then ' and open
   Else
      If objConn.State=adStateStillExecuting Then
          'Should we check other states???
      End If
   End If
Else
   Set objConn = New ADODB.Connection
   objConn.Open objConn.Open "Provider=sqloledb.1;data source=clovis-003;Initial catalog=" & UseDatabase & ";Integrated Security=SSPI;"
End If
.
.
.

 

[CaptainD]

Just below the loop and the msgbox I set the rs to nothing

>.'Move to the first record
>heet3.Range("A2").Activate
>>Set rs = Nothing
>bLoading = False
>Exit Sub
>ErrHandler:

> MsgBox "Error loading data, error # " & Err.Number >& ", " & Err.Description, vbOKOnly, "Error"
>> Set rs = Nothing
>End Sub

In the function if I set the connection to nothing I get an error that states I can't close the connection while the recordset is open. I guess I could close it in the getData sub

 

[JerryKlmns]

>Just below the loop and the msgbox I set the rs to nothing
Yes! But I said close it first then destroy it

>I guess I could close it in the getData sub
Depends, if you declare the objConn in the same module as the getData sub or make it [blue]Public[/blue]

Of course you could save the recordset, close it, destroy it, close connection, destroy connection and in getData sub open the saved recordset and use it! BUT it is more time consumming.

 

[CaptainD]

Gotcha, I'll try closing the recordset. I've heard of closing the connection before but not the recordset so I'll see what that does and also research it a little

Thanks