Select random item from 1d array no repeat

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

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.

Select Random Item Series

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