A better way to write to a range

The example in the preceding section uses a For-Next loop to transfer the contents of an array to a worksheet range. In this section, I demonstrate a more efficient way to accomplish this.

Start with the example that follows, which illustrates the most obvious (but not the most efficient) way to fill a range. This example uses a For-Next loop to insert its values in a range.

Sub LoopFillRange()

' Fill a range by looping through cells

Dim CellsDown As Long, CellsAcross As Integer Dim CurrRow As Long, CurrCol As Integer Dim StartTime As Double Dim CurrVal As Long

' Get the dimensions

CellsDown = InputBox("How many cells down?") If CellsDown = 0 Then Exit Sub

CellsAcross = InputBox("How many cells across?") If CellsAcross = 0 Then Exit Sub

' 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

ActiveCell.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

The example that follows demonstrates a much faster way to produce the same result. This code inserts the values into an array and then uses a single statement to transfer the contents of an array to the range.

Sub ArrayFillRange()

' Fill a range by transferring an array

Dim CellsDown As Long, CellsAcross As Integer

Dim i As Long, j As Integer

Dim StartTime As Double

Dim TempArray() As Long

Dim TheRange As Range

Dim CurrVal As Long

' Get the dimensions

CellsDown = InputBox("How many cells down?") If CellsDown = 0 Then Exit Sub

CellsAcross = InputBox("How many cells across?") If CellsAcross = 0 Then Exit Sub

' Record starting time StartTime = Timer

' Redimension temporary array

ReDim TempArray(1 To CellsDown, 1 To CellsAcross)

' Set worksheet range

Set TheRange = ActiveCell.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 + 1 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

On my system, using the loop method to fill a 500 x 256-cell range (128,000 cells) took 12.81 seconds. The array transfer method took only 0.20 seconds to generate the same results - more than 60 times faster! The moral of this story? If you need to transfer large amounts of data to a worksheet, avoid looping whenever possible.

CD-ROM

A workbook that contains the WriteReadRange , Loop Fill Range , and ArrayFillRange procedures is available on the companion CD-ROM. The file is named loop vs array fill range.xlsm .

0 0

Post a comment