Select random cell in range

1.2k views Asked by At

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.

3

There are 3 answers

3
basodre On

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
0
Siddharth Rout On

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
0
FaneDuru On

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