Nonrepeatable random number function?

[sacman]

I'm needing a function that can calculate a random number between 1 and 'x' (where x is the total available numbers) without repeating a number until all numbers have been used one time. The total available numbers changes as I add more data thus the reason for 'x'.



Allen

 

[shg]

Public Function RandLong(Optional iMin As Long = 1, _
                         Optional iMax As Long = -2147483647, _
                         Optional bVolatile As Boolean = False) As Variant
    ' UDF only!
    ' Returns numbers between iMin and iMax to the calling range
    ' UDF wrapper for aiRandLong
    
    ' shg 2008
    Dim nRow        As Long     ' rows in calling range
    Dim nCol        As Long     ' columns in calling range
    Dim iRow        As Long     ' row index
    Dim iCol        As Long     ' col index
    Dim aiTmp()     As Long     ' 1D temp array
    Dim aiOut()     As Long     ' output array
 
    If bVolatile Then Application.Volatile True
 
    With Application.Caller
        nRow = .Rows.Count
        nCol = .Columns.Count
    End With
 
    ReDim aiOut(1 To nRow, 1 To nCol)

    If iMin = 1 And iMax = -2147483647 Then iMax = nRow * nCol

    aiTmp = aiRandLong(iMin, iMax, nRow * nCol)
    For iRow = 1 To nRow
        For iCol = 1 To nCol
            aiOut(iRow, iCol) = aiTmp((iCol - 1) * nRow + iRow)
        Next iCol
    Next iRow
 
    RandLong = aiOut
End Function
 
Public Function aiRandLong(iMin As Long, _
                           iMax As Long, _
                           Optional ByVal n As Long = -1, _
                           Optional bVolatile As Boolean = False) As Long()
    ' UDF or VBA
    ' Fisher-Yates shuffle
    ' Returns a 1-based array of n unique Longs between iMin and iMax inclusive

    Dim aiSrc()     As Long     ' array of numbers iMin to iMax
    Dim iSrc        As Long     ' index to aiSrc
    Dim iTop        As Long     ' decreasing upper bound for next selection
    Dim aiOut()     As Long     ' output array
    Dim iOut        As Long     ' index to aiOut
 
    If bVolatile Then Application.Volatile True
    If n < 0 Then n = iMax - iMin + 1
    If iMin > iMax Or n > (iMax - iMin + 1) Or n < 1 Then Exit Function
    ReDim aiSrc(iMin To iMax)
    ReDim aiOut(1 To n)
    ' init iSrc
    For iSrc = iMin To iMax
        aiSrc(iSrc) = iSrc
    Next iSrc
    iTop = iMax

    For iOut = 1 To n
        ' Pick a number in aiSrc between 1 and iTop, copy to output,
        ' replace with the number at iTop, decrement iTop
        iSrc = Int((iTop - iMin + 1) * Rnd) + iMin
        aiOut(iOut) = aiSrc(iSrc)
        aiSrc(iSrc) = aiSrc(iTop)
        iTop = iTop - 1
    Next iOut
    aiRandLong = aiOut
End Function

Select a range, and then paste this in the formula bar:

=RandLong()

Then press and hold the Ctrl & Shift keys, then press Enter.