Expert help needed! I'm stumped...
Posted by Rhona Mowatt on April 24, 2001 10:15 AM
Hi,
I have an Excel application that extracts data from an Access database and imports data into Excel depending on what criteria are selected by the user (through a form). The problem is that the VBA procedure that writes the data to the cells on the worksheet is very slow. A typical query returns about 10000 records with about 15 fields and it takes an about 10 seconds write the data. This may seem OK but some users are not impressed with the current performance when they are having to produce upto 10 reports an hour. Here is the code that writes the data:-
Sub WriteDataToCells(WriteRS As ADODB.Recordset)
Dim RecCount As Long, FieldCount As Integer
Dim Sht As Worksheet
Set Sht = ActiveSheet
Application.ScreenUpdating = False
'Write headers
For FieldCount = 0 To WriteRS.Fields.Count - 1
Sht.Cells(1, FieldCount + 1).Value = WriteRS.Fields(FieldCount).Name
Next FieldCount
'Now write the actual contents of the recordset
For RecCount = 0 To WriteRS.RecordCount - 1
For FieldCount = 0 To WriteRS.Fields.Count - 1
Sht.Cells(RecCount + 2, FieldCount + 1).Value _
= WriteRS.Fields(FieldCount).Value
Next FieldCount
WriteRS.MoveNext
Next RecCount
Application.ScreenUpdating = True
End Sub
Is there anyway I can speed up the process of writing the data to cells?
Thanks,
Rhona.
Posted by Rhona Mowatt on April 24, 2001 1:51 PM
Please anyone! I'll pay you a tenner!
Posted by Ivan Moala on April 24, 2001 5:54 PM
Re: Please anyone! I'll pay you a tenner!
Hi Rhona
Try this routine, untested !
Uses array variants to store data and write once
instead of read/writing 1000's of times.
Sub WriteDataToCellsTest(WriteRS As ADODB.Recordset)
Dim RecCount As Long, FieldCount As Integer
Dim Sht As Worksheet
Dim FastArrayFData() As Variant
Dim FastArrayFHeaders() As Variant
Set Sht = ActiveSheet
Application.ScreenUpdating = False
ReDim FastArrayFData(WriteRS.RecordCount, WriteRS.Fields.Count)
ReDim FastArrayFHeaders(1, WriteRS.Fields.Count)
'Read & Store headers in Variant array
For FieldCount = 0 To WriteRS.Fields.Count - 1
FastArrayFHeaders(1, FieldCount + 1) = WriteRS.Fields(FieldCount).Name
Next FieldCount
'Now read the actual contents of the recordset into variant array
For RecCount = 0 To WriteRS.RecordCount - 1
For FieldCount = 0 To WriteRS.Fields.Count - 1
FastArrayFData(RecCount - 1, FieldCount - 1) = WriteRS.Fields(FieldCount).Value
Next FieldCount
WriteRS.MoveNext
Next RecCount
'Now write to sheet superfast
Sht.Cells(1, 1).Resize(1, FieldCount) = FastArrayFHeaders
Sht.Cells(2, 1).Resize(WriteRS.RecordCount, WriteRS.Fields.Count) = FastArrayFData
Application.ScreenUpdating = True
End Sub
HTH
Ivan
Posted by Rhona Mowatt on April 25, 2001 10:27 AM
Fantastic!
Ivan,
After a bit of tweaking this works amazingly quickly. I timed a few test queries and it worked 40 times quicker than my previous method!
Thankyou very much,
Rhona.
PS Cheque in post!
Posted by Ivan Moala on April 25, 2001 6:26 PM
Re: Fantastic!
Glad you were able to tweak it and get it to run.
Expecting the check any time now :-)
Ivan
