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

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

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

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

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

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.

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. ## Author: Tomasz Płociński

I'm very advanced in VBA, Excel, also easily linking VBA with other Office applications (e.g. PowerPoint) and external applications (e.g. SAP). I take part also in RPA processes (WebQuery, DataCache, IBM Access Client Solutions) where I can also use my SQL basic skillset. I'm trying now to widen my knowledge into TypeScript/JavaScript direction.

Posted on Categories Arrays, Excel, Excel VBA