Randomly select cell with no repeats, and then reset so that all cells are possible

user_12351932 0
Viewed 33

I have a list of cells that I want to randomly select from by clicking a button with no repeats, and display the value in another cell. After a certain point I want to be able to "reset" so that all of the cells are eligible to be chosen, weather that's after 2 random selections or after 50.

I already have a macro to randomly select a cell and display that cell's value somewhere else (see below).

Sub MGen()
Dim ws As Worksheet
Dim stRow As Long, endRow As Long, dataCol As Long
Dim dispRow As Long, dispCol As Long

Set ws = Sheets("MHome")
stRow = 2
dataCol = 1
dispRow = 3
dispCol = 4

    With ws
        endRow = .Cells(.Rows.Count, dataCol).End(xlUp).Row
        .Cells(dispRow, dispCol).Value = _
          .Cells(Application.RandBetween(stRow, endRow), dataCol).Value
    End With

End Sub

With altering this macro for no repeats, do I need another macro for the "reset"?

vba excel
1 Answers

I propose to use a "virtual" list of randomly sorted values (m_arrRandomSortOrder) that is retrieved by the function getListRandomSortOrder

Calling the getValueFromRandomList-function returns the next value from the array and increases the module level variable m_NextIndex.

reset does what it is called: returns a new randomly sorted array and resets m_NextIndex to 0

I am assuming that there are to workbook names:

  • Values: the range you take the values from
  • Target: the cell where you want to write the random value

writeNewValue or reset have to be called from "outside"

Option Explicit

Private Const nameTargetCell As String = "Target"
Private Const nameValueRange As String = "Values"

Private m_arrRandomSort As Variant
Private m_NextIndex As Long


Public Sub writeNewValue()
Dim rgTarget As Range: Set rgTarget = ThisWorkbook.Names(nameTargetCell).RefersToRange
rgTarget.Value = getValueFromRandomList
End Sub


Public Sub reset()

Dim rgValues As Range
Set rgValues = ThisWorkbook.Names(nameValueRange).RefersToRange

m_arrRandomSort = getListRandomSortOrder(rgValues)
m_NextIndex = 0

End Sub


Private Function getValueFromRandomList() As Variant

'this function returns the next value from the randomly sorted array
'when all values have been selected (m_lastindex +1 > ubound of m_arrRandomSort
'user is asked to reset or to cancel

If Not IsArray(m_arrRandomSort) Then
    reset
ElseIf m_NextIndex > UBound(m_arrRandomSort) Then
    If vbOK = MsgBox("All values have been selected." & vbCrLf & _
        "Reset the list?", vbOKCancel + vbExclamation) Then
        reset
    Else
        Exit Function
    End If
End If

getValueFromRandomList = m_arrRandomSort(m_NextIndex)
m_NextIndex = m_NextIndex + 1

End Function



Private Function getListRandomSortOrder(rg As Range) As Variant

'this function returns a one-dimensional array where all values of rg are randomly sorted
Dim arr1 As Variant, arr2 As Variant

With Application.WorksheetFunction
    arr1 = .SortBy(rg, .RandArray(rg.Rows.Count), 1)
End With

Dim i As Long
ReDim arr2(0 To UBound(arr1, 1) - 1)
For i = 0 To UBound(arr2)
    arr2(i) = arr1(i + 1, 1)
Next

getListRandomSortOrder = arr2

End Function
user_165784240
Related