Link to home
Start Free TrialLog in
Avatar of A G
A GFlag for United States of America

asked on

Picking from a Random List Without Repetition in vba

On VBA I have two arrays, a() and b()
a() is filled with a set of values from an excel spreadsheet
b() is filled by selecting random numbers from a().
I want b() to be filled by selecting random numbers from a() without repetition.
Right now I am using a function like the following
b(z, J) = a(Int(((totalvalues - 6) - 1 + 1) * Rnd + 1), J)
How would i do the same thing and ensure there are no repetitons?
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Using code like the following you can check to see if an item is in b() and not add it again if it is.

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const LB_FINDSTRINGEXACT = &H1A2
Private Sub Command1_Click()
    
If (SendMessage(List1.hwnd, LB_FINDSTRINGEXACT, -1&, _
                        ByVal CStr(strSomeValue))) > -1& Then
    'Don't add it
Else
    'Add it
End If

Open in new window

I'm sorry, ignore that.
Create a third array c() filled with random numbers, same dimension as a(). Populate b array by picking the n smallest values in c, drawing values from the a array with corresponding index numbers.

Sub RandomPicker()
Dim a(20) As Variant, b(5) As Variant
Dim c() As Double, d As Double
Dim i As Long, j As Long, k As Long, n As Long, nPicks As Long
n = UBound(a)
ReDim c(n)
nPicks = UBound(b)

For i = LBound(c) To n
    a(i) = Chr(64 + i)  'Populate a array
    c(i) = Rnd()        'Populate c array
Next
For i = LBound(b) To nPicks
    k = i - LBound(b) + 1   'Index reference starting with 1
    d = Application.Small(c, k)
    j = Application.Match(d, c, 0)
    b(i) = a(j)
    Debug.Print b(i)       'Print value chosen in Immediate pane
Next
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Arno Koster
Arno Koster
Flag of Netherlands image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial