How can I speed up my code ? 1

[MissyEd]

Hi there

I have a report to create in Excel from scratch with data from Access, but its taking 9 minutes at the moment on a 466MHZ PC with 64MB RAM. I am using DLOOKUP to search for a value in one table, if its not found there, I DLOOKUP another table and if its still not found, I set the cell color to yellow in excel. Is it more efficient and faster to use .findfirst ? Any advice gratefully received.

My Code is below :

Private Sub s_RPT_Difference_CreateBodyDifference()
On Error GoTo err_s_RPT_Difference_CreateBodyDifference
'
' Create body in Excel spreadsheet
'
Dim xlApp As New Excel.Application, xlSheet As Excel.Worksheet
Dim RangeCurrent As Excel.Range, dbcurrent As Database
Dim rstWeekNumbers As Recordset, rstExcelRows As Recordset
Dim iColCount As Integer, iRowCount As Integer

' Open excel
Set xlApp = Excel.Application
xlApp.Workbooks.Open f_FILELOCATION_ReturnLocation("ANNUAL.XLS&quot
Set xlSheet = xlApp.Worksheets("Annual Diff&quot
Set RangeCurrent = xlSheet.Range("C5&quot
iColCount = 0
iRowCount = 0

' Open database
Set dbcurrent = CurrentDb()
Set rstWeekNumbers = dbcurrent.OpenRecordset("SELECT * FROM WEEK_NUMBERS WHERE CURRENT_YEAR = '2000' ORDER BY WEEK_END_DATE ASC;&quot
Set rstExcelRows = dbcurrent.OpenRecordset("SELECT * FROM EXCEL_ROWS ORDER BY BRANCH_NUMBER;", dbOpenDynaset)

' Loop through recordsets
With rstWeekNumbers
If Not .EOF Then .MoveLast
If Not .BOF Then .MoveFirst
If .RecordCount > 0 Then
' Copy over records
Do While Not .EOF
If Not rstExcelRows.EOF Then rstExcelRows.MoveLast
If Not rstExcelRows.BOF Then rstExcelRows.MoveFirst
' Write data
If rstExcelRows.RecordCount > 0 Then
Do While Not rstExcelRows.EOF
If IsNull(DLookup("BALANCE", "DIFFERENCES", "BRANCH_NUMBER = " & rstExcelRows!BRANCH_NUMBER & " AND WEEK_ENDING_DATE = #" & Format(!WEEK_END_DATE, "mm/dd/yyyy&quot & "#&quot) Then
' Value not found in difference table, lookup difference derived.
If IsNull(DLookup("BALANCE", "DIFFERENCES_DERIVED", "BRANCH_NUMBER = " & rstExcelRows!BRANCH_NUMBER & " AND WEEK_ENDING_DATE = #" & Format(!WEEK_END_DATE, "mm/dd/yyyy&quot & "#&quot) Then
' Value not found in difference derived table, paint cell yellow
RangeCurrent.Offset(iRowCount, iColCount).Interior.ColorIndex = 6
RangeCurrent.Offset(iRowCount, iColCount).Interior.Pattern = xlSolid
Else
' Value found in difference derived table, write to spreadshet.
RangeCurrent.Offset(iRowCount, iColCount).Value = DLookup("BALANCE", "DIFFERENCES_DERIVED", "BRANCH_NUMBER = " & rstExcelRows!BRANCH_NUMBER & " AND WEEK_ENDING_DATE = #" & Format(!WEEK_END_DATE, "mm/dd/yyyy&quot & "#&quot
End If
Else
' Value found in difference table, write to excel spreadsheet.
RangeCurrent.Offset(iRowCount, iColCount).Value = DLookup("BALANCE", "DIFFERENCES", "BRANCH_NUMBER = " & rstExcelRows!BRANCH_NUMBER & " AND WEEK_ENDING_DATE = #" & Format(!WEEK_END_DATE, "mm/dd/yyyy&quot & "#&quot
End If
iColCount = iColCount + 1
rstExcelRows.MoveNext
Loop
iColCount = 0
End If
iRowCount = iRowCount + 1
.MoveNext
Loop
End If
End With

' Close database objects
rstWeekNumbers.Close
rstExcelRows.Close
dbcurrent.Close

' Save excel
xlApp.ActiveWorkbook.Save
xlApp.Quit

' Destroy objects
Set rstExcelRows = Nothing
Set rstWeekNumbers = Nothing
Set dbcurrent = Nothing
Set RangeCurrent = Nothing
Set xlSheet = Nothing
Set xlApp = Nothing

exit_s_RPT_Difference_CreateBodyDifference:
Exit Sub

err_s_RPT_Difference_CreateBodyDifference:
Beep
MsgBox "An error has occured. Please contact IT with details below" & vbNewLine & _
vbNewLine & Err.Number & vbNewLine & Err.Description
Resume exit_s_RPT_Difference_CreateBodyDifference
End Sub

Missy Ed
Looking to exchange ideas and tips on VB and MS Access development as well as office 97 development.

 

[ColinM]

Make sure that you have indexes on your lookup fields:
BRANCH_NUMBER and WEEK_ENDING_DATE

Might help slightly.

Or have a look at the seek method in the help file. (don't know if this is faster but again uses indexes)

 

[MichaelRed]

The intrinsic domain aggregate functions in Ms. Access are noted to be the slowest way to get values. They should only be used as the LAST resort. It is almost always faster to generate a seperate query to get the value(s) from a dataset than to use these.

Also, without checking each character, it 'looks like' you are doing the same DLookUp within the code. It would save some time to re-arrange the function to just get the value once and use it in the two places (this is true regardless of wheather you replace the dlookup w/ another way to retrieve the value).



MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over

 

[MissyEd]

Thanks Michael and Colin - I changed the DLOOKUP's to .findfirst using a recordset, sorted out the indexes and its down to 2mins. Much better Missy Ed
Looking to exchange ideas and tips on VB and MS Access development as well as office 97 development. Drop me a line: msedbbw@hotmail.com

 

[MichaelRed]

MisseyEd,

Now look into the 'Seek" method. Much like the .findfirst, except MUCH faster. If your recordsets are non-trivial, changing to this method will probably cut your time in half.

Changing from .FindFirst to .Seek is also easier than the change drom DLookUp to .FindFirst, so if you were able to do that in the hour or so, this will be a 'breeze' (not that anyone in my locale wants any more Breeze!).



MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over

 

[jimmythegeek]

Another thing that is slowing you down is the .Movelast and Movefirst methods you are using. In the bit of code I copied below, you do not need the 4 red lines:

==========
.....

' Loop through recordsets
With rstWeekNumbers
If Not .EOF Then .MoveLast
If Not .BOF Then .MoveFirst
If .RecordCount > 0 Then
' Copy over records
Do While Not .EOF
If Not rstExcelRows.EOF Then rstExcelRows.MoveLast
If Not rstExcelRows.BOF Then rstExcelRows.MoveFirst
' Write data
If rstExcelRows.RecordCount > 0 Then
Do While Not rstExcelRows.EOF
.....
==========

When you open a recordset, the only reason you would want to use the .Movelast method is to get an accurate record count of all records in the recordset.

When a recordset is INITIALLY opened, the .Recordcount property does NOT return an integer with the number of records, but a true or false on whether there are records or not. So unless you NEED to know how many records there are, DO NOT use the .Movelast method. This could slow your code down considerably if there are alot of records in your recordset.

The following should work just as well, and should be faster.

==========
.....

' Loop through recordsets
With rstWeekNumbers
If .RecordCount > 0 Then
' Copy over records
Do Until .EOF
' Write data
If rstExcelRows.RecordCount > 0 Then
Do Until rstExcelRows.EOF
..... Jim Lunde
compugeeks@hotmail.com
Custom Application Development

 

[MissyEd]

Thanks a lot guys! Used the .seek and .movelast suggestions and am down to 1minute. Absolutely brilliant !

Snogs all round and merry xmas to all

Missy Ed
Looking to exchange ideas and tips on VB and MS Access development as well as office 97 development. Drop me a line: msedbbw@hotmail.com