HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Replacing a For Each loop with something faster

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
eachwithloopfasterreplacingforsomething

Problem

I'm a very inexperienced VBA user, I've just created my first "For Each" loop but it's very slow. I'm happy that it works but eager to know if there is a alternative method that is quicker. Any advice would be appreciated but please bear in mind my inexperience!

My routine takes two variables "UserSelectionMin" and "UserSelectionMax" and uses them in conjunction with the RandBetween function to place a value in every cell in the selected range (all the selected cells will be empty).

Sub RandomScores()

Dim addr As String
addr = Selection.Address

' opens a userform and collects the min value, assigned to UserSelectionMin (which is declared as an integer)
MinScore
' opens a userform and collects the max value, assigned to UserSelectionMax (which is declared as an integer)
MaxScore

For Each c In Worksheets("matches").Range(addr).Cells
If Abs(c.Value) = 0 Then c.Value = WorksheetFunction.RandBetween(UserSelectionMin, UserSelectionMax)
Next

Unload RandomScoreFormMin
Unload RandomScoreFormMax

End Sub


The MinScore and MaxScore procedures are below although these bits seem to be working OK.

Sub MinScore()
With RandomScoreFormMin.ListBoxMin
.AddItem "0"
.AddItem "1"
End With
RandomScoreFormMin.Show vbModal
End Sub

Sub MaxScore()
With RandomScoreFormMax.ListBoxMax
    .AddItem "1"
    .AddItem "2"
    .AddItem "3"
End With
RandomScoreFormMax.Show vbModal
MsgBox "You selected " & UserSelectionMin & " as your min score and " & UserSelectionMax & " as your max score"
End Sub

Solution

This smells:

' opens a userform and collects the min value, assigned to UserSelectionMin (which is declared as an integer)
MinScore
' opens a userform and collects the max value, assigned to UserSelectionMax (which is declared as an integer)
MaxScore


You are using global variables - variables should have the tightest possible scope, and be passed to procedures as parameters; both MinScore and MaxScore should be Function procedures that return a value.

Sub MinScore()
With RandomScoreFormMin.ListBoxMin
.AddItem "0"
.AddItem "1"
End With
RandomScoreFormMin.Show vbModal
End Sub


Indentation is important for readability. It should look something like this:

Sub MinScore()
    With RandomScoreFormMin.ListBoxMin
        .AddItem "0"
        .AddItem "1"
    End With
    RandomScoreFormMin.Show vbModal
End Sub


However a more pressing issue is the fact that you are working against the form's default instance - which is a bad habit to take. Instead, you should create an object:

Dim view As RandomScoreFormMin
Set view = New RandomScoreFormMin

view.ListBoxMin.AddItem "0"
view.ListBoxMin.AddItem "1"

view.Show vbModal


and as I mentioned, that should be a function, which returns the user-selected min value:

Private Function GetMin() As Integer
    Dim view As RandomScoreFormMin
    Set view = New RandomScoreFormMin

    view.ListBoxMin.AddItem "0"
    view.ListBoxMin.AddItem "1"

    view.Show vbModal

    GetMin = view.ListBoxMin.Value
End Function


Now you no longer need to worry about loading/unloading the form, since a new instance is used every time this function is called. And then the calling code can use a local variable instead of a global:

Dim minValue As Integer
minValue = GetMin


Regarding the performance of the ForEach loop:

For Each c In Worksheets("matches").Range(addr).Cells
    If Abs(c.Value) = 0 Then 
        c.Value = WorksheetFunction.RandBetween(UserSelectionMin, UserSelectionMax)
    End If
Next


Taking the absolute value of the cell's content looks like a little hack - that would deserve a little comment to explain why it's done, otherwise a maintainer might deem it redundant, and remove it.

My guts are telling me that it's a way of getting an Integer value from the cell, even if the cell is empty. In that case, CInt(c.Value) would do a better job.

Another thing is that you are updating a worksheet in a tight loop; Excel is redrawing itself and recalculating the affected cells every time a value is written!

You can turn off screen updating and automatic calculation, while you're updating the sheet's contents:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


Just don't forget to set ScreenUpdating back to True and calculation back to automatic after the loop completes (ideally in an error handler, so that if a runtime error occurs, screen updating is turned back on), so that Excel doesn't appear to remain "frozen"!

You have a potential bug here:

Dim addr As String
addr = Selection.Address


You're using the currently selected range's address...

For Each c In Worksheets("matches").Range(addr).Cells


...and then you're assuming that this range is on the "matches" worksheet - and it may not be all the time. If you mean to work with Selection, know that it is a Range, so you could do this instead:

For Each c In Selection.Cells


Otherwise, you need to validate the Selection before you use it - is it on the worksheet you're expecting?

Using WorksheetFunction is inherently slow, and should be avoided as much as possible; if your goal is to return a random number between X and Y, you could use VBA's random number generator instead of a worksheet function - here's a little formula to get a random integer between lowerbound and upperbound:

Int ((upperbound - lowerbound + 1) * Rnd + lowerbound)


Rnd returns a number that's smaller than 1, and greater than or equal to 0. It should be used in conjunction with the Randomize keyword:

Randomize
For Each c In Selection.Cells
    c.Value = Int((UserSelectionMax - UserSelectionMin + 1) * Rnd + UserSelectionMin
Next

Code Snippets

' opens a userform and collects the min value, assigned to UserSelectionMin (which is declared as an integer)
MinScore
' opens a userform and collects the max value, assigned to UserSelectionMax (which is declared as an integer)
MaxScore
Sub MinScore()
With RandomScoreFormMin.ListBoxMin
.AddItem "0"
.AddItem "1"
End With
RandomScoreFormMin.Show vbModal
End Sub
Sub MinScore()
    With RandomScoreFormMin.ListBoxMin
        .AddItem "0"
        .AddItem "1"
    End With
    RandomScoreFormMin.Show vbModal
End Sub
Dim view As RandomScoreFormMin
Set view = New RandomScoreFormMin

view.ListBoxMin.AddItem "0"
view.ListBoxMin.AddItem "1"

view.Show vbModal
Private Function GetMin() As Integer
    Dim view As RandomScoreFormMin
    Set view = New RandomScoreFormMin

    view.ListBoxMin.AddItem "0"
    view.ListBoxMin.AddItem "1"

    view.Show vbModal

    GetMin = view.ListBoxMin.Value
End Function

Context

StackExchange Code Review Q#82508, answer score: 4

Revisions (0)

No revisions yet.