Place a VBA array into an excel range

Posted By : matt.nelson at 2:03 pm, 30 March 2010    In Group : Excel

When using Excel and VBA to sort through large amount of data, most people will simply use a 'For Loop' or a 'While Wend' to write data from an array back to the sheet. This is extremely inefficient. Have a look at this short code snippet to see how to dump large amounts of data from an array into an excel range.

To see just how slow it is to write to the sheet every loop, just test out the sub below. This will write 100'000 cells of data and will probably take around 10 seconds.

Sub LoopFillRange()
' Fill a range by looping through cells
Dim CellsDown As Long, CellsAcross As Long
Dim CurrRow As Long, CurrCol As Long
Dim StartTime As Double
Dim CurrVal As Long

' Change these values
CellsDown = 500
CellsAcross = 200

Cells.Clear
' Record starting time
StartTime = Timer

' Loop through cells and insert values
CurrVal = 1
Application.ScreenUpdating = False
For CurrRow = 1 To CellsDown
For CurrCol = 1 To CellsAcross
Range("A1").Offset(CurrRow - 1, CurrCol - 1).Value = CurrVal
CurrVal = CurrVal + 1
Next CurrCol
Next CurrRow

' Display elapsed time
Application.ScreenUpdating = True
MsgBox Format(Timer - StartTime, "00.00") & " seconds"
End Sub 

On my system, writing 100,000 values using a loop takes 9.73 seconds. A faster way to accomplish the task is to put the value in an array, and then transfer the array to the worksheet. The procedure below writes 100,000 values in 0.16 second — about 60 times faster than the looping method.

 
Sub ArrayFillRange()
'   Fill a range by transferring an array
   Dim CellsDown As Long, CellsAcross As Long
    Dim i As Long, j As Long
    Dim StartTime As Double
    Dim TempArray() As Double
    Dim TheRange As Range
    Dim CurrVal As Long

'   Change these values
   CellsDown = 500
    CellsAcross = 200

    Cells.Clear
'   Record starting time
   StartTime = Timer

'   Redimension temporary array
   ReDim TempArray(1 To CellsDown, 1 To CellsAcross)

'   Set worksheet range
   Set TheRange = Range(Cells(1, 1), Cells(CellsDown, CellsAcross))

'   Fill the temporary array
   CurrVal = 0
    Application.ScreenUpdating = False
    For i = 1 To CellsDown
        For j = 1 To CellsAcross
            TempArray(i, j) = CurrVal
            CurrVal = CurrVal + 1
        Next j
    Next i

'   Transfer temporary array to worksheet
   TheRange.Value = TempArray

'   Display elapsed time
   Application.ScreenUpdating = True
    MsgBox Format(Timer - StartTime, "00.00") & " seconds"
End Sub 

There are no comments to show

      Be the first to leave a message below

Leave a Reply