Optimizing performance of double loop in VBA Excel

Question

I'm interested in knowing the fastest way to execute a set of instructions in double loop to loop through a two-dimensional range of cells. My code will be like this:

Sub Test()

For i = 1 To 1000000
    For j = 1 To 10   'It can be more than 10
        'I put a set of instructions here
    Next j
Next i

End Sub

For example, suppose I write a simple code to implement such a following task:

Sub Test1()
T0 = Timer
For i = 1 To 1000000
    For j = 1 To 10
        Cells(i, j) = j + Rnd()
    Next j
Next i
InputBox "The runtime of this program is ", "Runtime", Timer - T0
End Sub

I ran the procedure Test1 on my machine, it took 179.6406 seconds to complete. Since I don't declare the variables (i and j), the Test1 is running with those variables defaulting to the Variant type. I then add one line to the Test1 to declare the variables as Longs, since VBA is optimized for Longs. The new procedure, Test2, brought the running time on my machine down to 168.7539 seconds (almost 11 seconds faster).

To improve performance of Test2, I turned off Excel functionality that isn't needed while Test2 code runs.

Sub Test3()
Dim i As Long, j As Long
T0 = Timer

ScreenUpdateState = Application.ScreenUpdating
StatusBarState = Application.DisplayStatusBar
CalcState = Application.Calculation
EventsState = Application.EnableEvents
DisplayPageBreakState = ActiveSheet.DisplayPageBreaks
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

For i = 1 To 1000000
    For j = 1 To 10
        Cells(i, j) = j + Rnd()
    Next j
Next i

Application.ScreenUpdating = ScreenUpdateState
Application.DisplayStatusBar = StatusBarState
Application.Calculation = CalcState
Application.EnableEvents = EventsState
ActiveSheet.DisplayPageBreaks = DisplayPageBreaksState

InputBox "The runtime of this program is ", "Runtime", Timer - T0
End Sub

The above method helps improve the performance of Test2 and Test3 completes in 96.13672 seconds on my machine. So I'm wondering if there is a more effective way for doing this. Can anyone come up with a quicker version? If possible, even avoiding the double loop procedure.

Answer 1

I used an internal VBA array and this ran in under 10 seconds:

Sub QuickTest()
    Dim v(1 To 1000000, 1 To 10) As Double
    For i = 1 To 1000000
        For j = 1 To 10
            v(i, j) = j + Rnd
        Next j
    Next i

    Range("A1:J1000000") = v
End Sub

Note:

• the use of an internal VBA array allows us to avoid "touching" the worksheet more than once
• the array can be transferred to the worksheet cells in one step rather than in a loop.

EDIT#1:

Consider this sequel:

Sub QuickTest2_The_Sequel()
    Dim i As Long, j As Long, m As Long, n As Long
    Range("K1") = Evaluate("Now()")

    m = 10
    n = 1000000

    ReDim v(1 To n, 1 To m) As Double
    For i = 1 To n
        For j = 1 To m
            v(i, j) = j + Rnd
        Next j
    Next i

    Range("A1:J" & n) = v
    Range("K2") = Evaluate("Now()")
End Sub

Here we use cells K1 and K2 to record the start and stop times. We also use ReDim rather than Dim to "paramatize" the limits:

Answer 2

Sub Checkthis()
    starttime = Format(Now(), "hh:mm:ss")
    Dim i, j As Long
    Dim a(1000000, 10) As Long
    For i = 1 To 1000000
        For j = 1 To 10
            a(i, j) = j + Rnd
        Next j
    Next i
    Range("A1:J1000000") = a
    endtime = Format(Now(), "hh:mm:ss")
    Elapsed = DateDiff("s", starttime, endtime)
    MsgBox ("Finished in " & Elapsed & " seconds")
End Sub