MrExcel Publishing
Your One Stop for Excel Tips & Solutions

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