CODEWITHSUNDEEP
performancevbaexcel
Octavio
Octavio

Reputation: 456

Excel VBA: Writing an array to cells is very slow

I am working with VBA in Excel to retrieve some information from the Reuters 3000 Database. The data I retrieve comes as a bidimensional array consisting of one column holding dates and other column holding numeric values.

After I retrieve the information, a process that takes no more than 2 seconds, I want to write this data to a worksheet. In the worksheet I have a column with dates and several other columns with numeric values, each column containing values of a same category. I iterate over the rows of the array to get the date and numeric value and I keep those in a variable, then I search for the date on the date column of the worksheet and after I've found the date I write the value. Here is my code:

Private Sub writeRetrievedData(retrievedData As Variant, dateColumnRange As String, columnOffset As Integer)

Dim element As Long: Dim startElement As Long: Dim endElement As Long
Dim instrumentDate As Variant: Dim instrumentValue As Variant
Dim c As Variant: Dim dateCellAddress As Variant

Application.ScreenUpdating = False    
Sheets("Data").Activate
startElement = LBound(retrievedData, 1): endElement = UBound(retrievedData, 1)
Application.DisplayStatusBar = True
Application.StatusBar = "Busy writing data to worksheet"

For element = startElement To endElement
    instrumentDate = retrievedData(element, 1): instrumentValue = retrievedData(element, 2)
    Range(dateColumnRange).Select
    Set c = Selection.Find(What:=instrumentDate, After:=ActiveCell, LookIn:=xlValues, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False)
    If Not c Is Nothing Then
        c.offset(0, columnOffset).Value = instrumentValue            
    End If
Next element

Application.DisplayStatusBar = False

End Sub

My problem is that this process is very slow, even if I have only 5 rows in the array it takes about 15 seconds to complete the task. As I want to repeat this process several times (once per each set of data I retrieve from the database), I would like to decrease the execution time as much as possible.

As you can see, I am disabling the update of the screen, which is one of the most recurrent actions to improve performance. Does anybody have a suggestion on how I can further decrease the execution time?

PS. I know the data retrieval process does not take much because I already tested that part (displaying values on a MsgBox as soon as the data has been retrieved)

Thanks in advanced.

Upvotes: 1

Views: 9674

Answers (2)

Jim Snyder
Jim Snyder

Reputation: 39

By not selecting the sheet, you can add a bit more speed. Instead of 

Sheets("Data").Activate
Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
loadDateArray = Date_Arr

Try

With Sheets("Data")
Date_Arr = .Range(Cells(3, 106), Cells(3, 106).End(xlDown))
End With

Upvotes: 1

Octavio
Octavio

Reputation: 456

This is what I did to improve the performance:

  • Avoid selecting the cell when the value is going to be written. This was a suggestion of Tim Williams.
  • I set the property Application.Calculation to xlCalculationManual

  • Instead of using the Find() function to search for the date, I loaded all the dates from the worksheet into an array and iterate over this array to get the row number. This turns out to be faster than the Find() function.

    Private Function loadDateArray() As Variant

    Dim Date_Arr() As Variant

    Sheets("Data").Activate
    Date_Arr = Range(Cells(3, 106), Cells(3, 106).End(xlDown))
    loadDateArray = Date_Arr

End Function

Private Function getDateRow(dateArray As Variant, dateToLook As Variant)

    Dim i As Double: Dim dateRow As Double

    For i = LBound(dateArray, 1) To UBound(dateArray, 1)
        If dateArray(i, 1) = dateToLook Then
            dateRow = i
            Exit For
        End If
    Next i

    getDateRow = dateRow

End Function

Thank you all for your help!

Upvotes: 6

Related Questions