Reputation: 61
I'm trying to perform an action in VBA on a range of cells. I would like the selection of the cells to be random not in the order of how the range is setup.
Sub Solver_Step_Evo()
Set Rng = GetRange(ThisWorkbook.ActiveSheet.Range("Variable_Range"))
For Each i In Rng
'perform an action on I where I is randomly selected.
Next i
End Sub
My preference is it randomizes the order not just randomly select a cell where a cell can be picked more than once.
Thanks in advance.
Upvotes: 0
Views: 1497
Reputation: 42236
Try the next function, please:
Function RndCell(rng As Range) As Range
Dim rndRow As Long, rndCol As Long
rndRow = WorksheetFunction.RandBetween(1, rng.rows.count)
rndCol = WorksheetFunction.RandBetween(1, rng.Columns.count)
Set RndCell = rng.cells(rndRow, rndCol)
End Function
It can be tested using the next simple sub:
Sub testSelectRandomCell()
Dim rng As Range
Set rng = Range("A2:D10")
RndCell(rng).Select
End Sub
Edited:
If the random selected cells should not repeat, the function can be adapted in the next way (using a Static
array to keep the already selected cells):
Function RndCellOnce(rng As Range, Optional boolClear As Boolean = False) As Range
Dim rndRow As Long, rndCol As Long, k As Long, El, arr1
Static arr
If boolClear And IsArray(arr) Then Erase arr
DoItAgain:
rndRow = WorksheetFunction.RandBetween(1, rng.rows.count)
rndCol = WorksheetFunction.RandBetween(1, rng.Columns.count)
If IsArray(arr) Then
If UBound(arr) = rng.cells.count - 1 Then
rng.Interior.Color = xlNone
ReDim arr(0): GoTo Over
End If
For Each El In arr
If El <> "" Then
arr1 = Split(El, "|")
If CLng(arr1(0)) = rndRow And CLng(arr1(1)) = rndCol Then GoTo DoItAgain
End If
Next El
ReDim Preserve arr(UBound(arr) + 1)
Else
ReDim arr(0)
End If
Over:
arr(UBound(arr)) = rndRow & "|" & rndCol
Set RndCellOnce = rng.cells(rndRow, rndCol)
End Function
It can be tested with the next Sub. In order to visually check it, each selected cell will get a yellow interior color. When all the range cells will be selected (one by one), the static array will be erased and the interior color will be cleaned:
Sub testSelectRandomCell()
Dim rng As Range
Set rng = Range("A2:D10")
With RndCellOnce(rng)
.Interior.Color = vbYellow
.Select
End With
End Sub
Upvotes: 1
Reputation: 5770
Here's a possible solution. I add all of the cells in the relevant range to a collection. Then, I navigate the collection using random indexes. Once an index has been visited, I remove it from the collection and repeat the process.
Does this work for you?
Edit: No need to call the c.Count
method for each iteration. We can manage this ourselves ourselves. It would likely be a bit more efficient than calling the object's method.
Sub SuperTester()
Dim c As Collection
Dim rng As Range
Dim cel As Range
Dim idx As Long
Dim remainingCount As Long
Set rng = Range("A2:A17")
Set c = New Collection
For Each cel In rng
c.Add cel
Next cel
remainingCount = c.Count
While remainingCount > 0
idx = WorksheetFunction.RandBetween(1, c.Count)
Debug.Print c.Item(idx).Address
c.Remove idx
remainingCount = remainingCount - 1
Wend
End Sub
Upvotes: 3
Reputation: 149305
You can use WorksheetFunction.RandBetween
to get random number between 2 numbers. The numbers will not be unique though. If you want unique then you will have to use a slightly different approach.
Option Explicit
Sub Solver_Step_Evo()
Dim Rng As Range
Set Rng = GetRange(ThisWorkbook.ActiveSheet.Range("Variable_Range"))
Dim lowerBound As Long: lowerBound = 1
Dim UpperBound As Long: UpperBound = Rng.Cells.Count
Dim randomI As Long
Dim i As Long
For i = lowerBound To UpperBound
randomI = Application.WorksheetFunction.RandBetween(lowerBound, UpperBound)
Debug.Print randomI
Next i
End Sub
Upvotes: 1