I am trying to select random item from 1d array using this code
Sub Select_Random_Item_From_1D_Array()
Dim arr(), x As Long
arr = Array("Good", "Very Good", "Excellent")
Randomize
x = Int((UBound(arr) + 1) * Rnd + 1)
Debug.Print arr(x - 1)
End Sub
How can I be able to prevent a repetition? I mean I need to select all the items randomly with no repetition. And if all the items are selected then to reset the process. Simply I need to select all the items randomly
This is a simple way to return a random permutation of an array that takes exactly n steps, where n is the number of entries in the array.
Dim arr(), x As Long, r As Long
arr = Array("Good", "Very Good", "Excellent")
x = UBound(arr)
While x >= 0
r = Int(Rnd * x)
Debug.Print arr(r)
arr(r) = arr(x)
x = x - 1
Wend
Pick r at random from (0,..,x) and print out arr(r). Then replace the entry at r with the entry at x, and choose again, but this time from (0,..,x-1), and repeat until x=0.
A fuller version that lets you read one entry at a time is here:
Place this in a module:
Public rarr(), ctr As Integer, arr()
Sub init()
With Cells
.Clear
.ColumnWidth = 10
End With
Dim x As Long, r As Long
arr = Array("Very Poor", "Poor", "Average", "Good", "Very Good", "Excellent")
x = UBound(arr)
ReDim rarr(0 To x)
Randomize
While x >= 0
r = Int(Rnd * x)
rarr(x) = arr(r)
arr(r) = arr(x)
x = x - 1
Wend
[a1:f1] = rarr
ctr = 0
End Sub
Sub Button1_Click()
Cells(ctr + 3, 1) = rarr(ctr)
ctr = ctr + 1
If ctr > UBound(rarr) Then init
End Sub
and add two buttons to the worksheet. Point one at init and the other at Button1_Click. Click init first, and then pressing Button1 displays a random and unique entry one at a time.
You could create a second array of Booleans, having the same length.
This array is initialized with only False. If a value from your array is selected by the rand, then set the boolean array matching value to True. And if the rand value next time is on a value which has already been selected (with a True in the boolean array), do the rand again
Try this little example step by step, you'll see the logic:
Sub Select_Random_Item_From_1D_Array()
Dim arr(), x As Long, cpt As Long
Dim mBool(2) As Boolean
cpt = 0
arr = Array("Good", "Very Good", "Excellent")
Do While cpt < 3 '3 being the number of items in your array + 1 (from 0 to 2)
Randomize
x = Int((UBound(arr) + 1) * Rnd + 1)
If mBool(x - 1) = False Then
mBool(x - 1) = True
Debug.Print arr(x - 1)
cpt = cpt + 1
End If
Loop
End Sub
It will print a random item from your array, and every time it does so it changes the matching value of the 2nd array from False to True. Then it does it again and if it has already been printed (if the matching value on the boolean array is True) it tries again.
I added a variable named cpt, which goes from 0 to the number of items in your array, it makes the algorithm stop when it has printed all the items one time.
This is probably not he best way to do what you want, but it works and it's not that complicated
Option Explicit
Sub resetRandomItem()
getRandomItem
End Sub
Sub selectRandomItem()
Dim arr As Variant
arr = Array("Bad", "Better", "Good", "Very Good", "Excellent")
Debug.Print getRandomItem(arr)
End Sub
' If x elements in 1D array, it returns a series of x different values.
Function getRandomItem(Optional Data1D As Variant) As Variant
Static arr As Variant
' Reset 'arr': use 'getRandomItem' without 'Data1D' parameter.
If IsMissing(Data1D) Then arr = Empty: Exit Function
If IsEmpty(arr) Then arr = Data1D
Dim lb As Long: lb = LBound(arr)
Dim ub As Long: ub = UBound(arr)
If lb = ub Then
getRandomItem = arr(lb)
arr = Empty
Else
Randomize
Dim x As Long: x = Int((ub - lb + 1) * Rnd + 1)
Dim y As Long: y = x + lb - 1
getRandomItem = arr(y)
arr(y) = Empty
Dim i As Long, k As Long
For i = lb To ub - 1
If arr(i) = Empty Then
For k = i + 1 To ub
arr(k - 1) = arr(k)
Next k
Exit For
End If
Next i
ReDim Preserve arr(ub - 1)
End If
End Function
