Unique constraint on random values

[aboons]

Hi all,

In my current project I use a formula that returns a random value from column A, based on the number of values in column A.

Like so: =INDEX(A:A;ROUNDDOWN(1+COUNTA(A:A)*RAND();0);0)

If in column A the number of values is 100, I may want to look at 10 of them that are randomly selected. Thus I enter the above formula in column B 10 times. My problem is, however, that duplicate values are being returned sometimes (which is logical).

How can I add a contraint that forces the values returned to be unique?

Regards.

 

[Weaver]

Does this have to be a formula, or could VB be used?

 

[aboons]

Hi Weaver,

VB would also be ok.

 

[Andrew Poulsom]

This may help you:

http://www.get-digital-help.com/2009/07/03/how-to-create-a-random-list-of-unique-numbers-in-excel/

 

[Weaver]

try

Function uniqueRandomPick(ByVal dr As Range, rr As Range, n As Long)
    Set dr = Range(dr, dr.End(xlDown))
    Randomize
    With CreateObject("scripting.dictionary")
        Do
            rn = Rnd() * dr.Cells.Count + 1
            If Not .exists(rn) Then
                .Add rn, dr.Cells(rn, 1)
            End If
        Loop Until UBound(.keys) = n - 1
        rr.Resize(n).Value = WorksheetFunction.Transpose(.items)
    End With
End Function

Call it with this sub

Sub test()
    uniqueRandomPick Range("A1"), Range("B1"), 10
End Sub

HTH

 

[aboons]

Thanks guys,

As it appears the RANDBETWEEN function is not available to me, so I'll go and try to make the VB code work for my specific situation.

 

[pgc01]

Thanks guys,

As it appears the RANDBETWEEN function is not available to me, so I'll go and try to make the VB code work for my specific situation.

Hi

Before excel 2007, to use RANDBETWEEN(), and other useful functions, you go to Tools->Add-ins and check the ToolPak add-in.

 

[T. Valko]

Thanks guys,

As it appears the RANDBETWEEN function is not available to me, so I'll go and try to make the VB code work for my specific situation.

What are the parameters of the RANDBETWEEN function?

You can probably use a RAND() equation to get the same result.

 

[aboons]

Hi Weaver,

I tried applying your code, but when the loop's finished, there's a Type mismatch in this line: rr.Resize.Value = WorksheetFunction.Transpose(.items)

 

[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

E.g., in B1:B10, array-entered

=RandLong(1, COUNTA(A:A))