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.
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 SubIV
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 SubV
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 SubVI
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 SubThe 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.
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.
