Looping performance 2 – can I speed it up?

After last tests I was not so surprised, but still proud of myself that found the difference between all in one loop and separated. However, I still felt a bit unsatisfied with possibly existing, other solutions and speed up looping performance. That’s why I decided to implement further modification.

Looping performance 2 - can I speed it up pyjama kid

For those who did not read the previous post, what I highly encourage You to do so, I need to remind the whole story, or at least the test case.

Test case

The test case was to fill the cells with random values and check every second column if the values are equal in previous column in the same row. The set up range was 1000 x 1000 cells.

Next solutions

My further modifications include array as the Excel table alternative, its 3rd dimension for color property, 2 arrays for values & color and other mixes of possible solutions.

Also I’d like to mention, that I will start enumeration with number 3. The first 2 modules were showed in last post, there is continuation in here.

Additionally I know that looping through rows and columns is double looping, but forgive me using single loop phrase. It is just easier to write.

III

In this solution I used array to gather all generated numbers (1st loop) and compare every second array column with previous to set the color number (2nd loop). In the last loop code is setting the color index number of table cells based on values from array.

Option Explicit

Sub sep_array1()

Dim ws As Worksheet
Dim i As Long, j As Long, x As Long, y As Long
Dim t1 As Double
Dim arr As Variant
Application.ScreenUpdating = False

x = 1000
y = 1000

Set ws = ThisWorkbook.Sheets(1)
ws.Range("A1").CurrentRegion.Clear

t1 = Timer
Progression.Show

With ws
    
    Progression.Text2.Caption = "1/3"
    For j = 1 To x
        For i = 1 To y
            .Cells(i, j) = Int(1 + Rnd * (100 - 1 + 1))
        Next
        Call progress(j, x)
    Next
    
    'ReDim arr(1 To y, 1 To x)
    arr = .Range(.Cells(1, 1), .Cells(y, x))
    
    Progression.Text2.Caption = "2/3"
    For j = 1 To x Step 2
        For i = 1 To y
            If arr(i, j) = arr(i, j + 1) Then
                arr(i, j) = 4
            Else
                arr(i, j) = 5
            End If
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "3/3"
    For j = 1 To x Step 2
        For i = 1 To y
            .Cells(i, j).Interior.ColorIndex = arr(i, j)
        Next
        Call progress(j, x)
    Next

End With

Unload Progression
Application.ScreenUpdating = True
Debug.Print "Separated1 array: " & Format(Timer - t1, "0.00")

End Sub

IV

Here, the random numbers generation, is done in array. Then, in the next loop code rewrites the values into table. The second part of code, about filling with color, is the same as in previous approach.

Option Explicit

Sub sep_array2()

Dim ws As Worksheet
Dim i As Long, j As Long, x As Long, y As Long
Dim t1 As Double
Dim arr As Variant
Application.ScreenUpdating = False

x = 1000
y = 1000

Set ws = ThisWorkbook.Sheets(1)
ws.Range("A1").CurrentRegion.Clear

t1 = Timer
Progression.Show

With ws
    ReDim arr(1 To y, 1 To x)
    Progression.Text2.Caption = "1/3"
    For j = 1 To x
        For i = 1 To y
            arr(i, j) = Int(1 + Rnd * (100 - 1 + 1))
        Next
        Call progress(j, x)
    Next
    For j = 1 To x
        For i = 1 To y
            .Cells(i, j) = arr(i, j)
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "2/3"
    For j = 1 To x Step 2
        For i = 1 To y
            If arr(i, j) = arr(i, j + 1) Then
                arr(i, j) = 4
            Else
                arr(i, j) = 5
            End If
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "3/3"
    For j = 1 To x Step 2
        For i = 1 To y
            .Cells(i, j).Interior.ColorIndex = arr(i, j)
        Next
        Call progress(j, x)
    Next

End With

Unload Progression
Application.ScreenUpdating = True
Debug.Print "Separated1 array1: " & Format(Timer - t1, "0.00")

End Sub

V

In this module I used 3d array to store the color property in the same array, next to the number values.

Option Explicit

Sub sep_array3()

Dim ws As Worksheet
Dim i As Long, j As Long, x As Long, y As Long
Dim t1 As Double
Dim arr As Variant
Application.ScreenUpdating = False

x = 1000
y = 1000

Set ws = ThisWorkbook.Sheets(1)
ws.Range("A1").CurrentRegion.Clear

t1 = Timer
Progression.Show

With ws
    ReDim arr(1 To y, 1 To x, 1 To 2)
    Progression.Text2.Caption = "1/4"
    For j = 1 To x
        For i = 1 To y
            arr(i, j, 1) = Int(1 + Rnd * (100 - 1 + 1))
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "2/4"
    For j = 1 To x Step 2
        For i = 1 To y
            If arr(i, j, 1) = arr(i, j + 1, 1) Then
                arr(i, j, 2) = 4
            Else
                arr(i, j, 2) = 5
            End If
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "3/4"
    For j = 1 To x
        For i = 1 To y
            .Cells(i, j) = arr(i, j, 1)
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "4/4"
    For j = 1 To x Step 2
        For i = 1 To y
            .Cells(i, j).Interior.ColorIndex = arr(i, j, 2)
        Next
        Call progress(j, x)
    Next
End With

Unload Progression
Application.ScreenUpdating = True
Debug.Print "Separated1 array3: " & Format(Timer - t1, "0.00")

End Sub

VI

In the last try I used 2 arrays for number values and cell color.

Option Explicit

Sub sep_array4()

Dim ws As Worksheet
Dim i As Long, j As Long, x As Long, y As Long
Dim t1 As Double
Dim arr As Variant, arr1 As Variant
Application.ScreenUpdating = False

x = 1000
y = 1000

Set ws = ThisWorkbook.Sheets(1)
ws.Range("A1").CurrentRegion.Clear

t1 = Timer
Progression.Show

With ws
    ReDim arr(1 To y, 1 To x)
    ReDim arr1(1 To y, 1 To x)
    Progression.Text2.Caption = "1/34"
    For j = 1 To x
        For i = 1 To y
            arr(i, j) = Int(1 + Rnd * (100 - 1 + 1))
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "2/4"
    For j = 1 To x Step 2
        For i = 1 To y
            If arr(i, j) = arr(i, j + 1) Then
                arr1(i, j) = 4
            Else
                arr1(i, j) = 5
            End If
        Next
        Call progress(j, x)
    Next
    
    Progression.Text2.Caption = "3/4"
    For j = 1 To x
        For i = 1 To y
            .Cells(i, j) = arr(i, j)
        Next
        Call progress(j, x)
    Next
    Progression.Text2.Caption = "4/4"
    For j = 1 To x Step 2
        For i = 1 To y
            .Cells(i, j).Interior.ColorIndex = arr1(i, j)
        Next
        Call progress(j, x)
    Next
End With

Unload Progression
Application.ScreenUpdating = True
Debug.Print "Separated1 array4: " & Format(Timer - t1, "0.00")

End Sub

The results

I made 13 tests for each approach. Yes, 13 each, don’t ask me why it is 13, long story. All the time results are compared in the graph below, including the first 2 modules from previous post.

Looping performance 2 - can I speed it up graph

So, we got a winner! It is obviously the III method, but there are small differences between those approaches – 0.3 sec. But still it is almost 2 whole seconds less than separated approach from last article.

Remember also about the test environment. The range of tables and arrays was 1000 x 1000 cells. I implemented inside the progress bar, which every refresh delays the final result – the more loops the more progress bar refreshes.

Summary

So, don’t take that for granted. It’s all about the situation, the procedures in loops and what You are aiming for. But hopefully now You learned some more ideas to speed up looping performance. Or at least this article was at some point entertaining for You.

Tomasz Płociński

Author: Tomasz Płociński

Excel VBA enthusiast who is also open for other languages. Mainly working in VBA, some SQL, hungry for more.

Leave a Reply

Your email address will not be published. Required fields are marked *