Picking from a Random List Without Repetition in vba

Posted on 2011-10-11
Last Modified: 2012-05-12
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?
Question by:awesomejohn19
    LVL 44

    Expert Comment

    by:Martin Liss
    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
        'Add it
    End If

    Open in new window

    LVL 44

    Expert Comment

    by:Martin Liss
    I'm sorry, ignore that.
    LVL 80

    Expert Comment

    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
    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
    End Sub

    Open in new window

    LVL 19

    Accepted Solution

    you could copy the valies of array A into a temporarily array C
    then select a randon number from 0 to the length of array C
    move the selected item from C to B (copy it from C to B, delete from array C)
    continue until C is empty.

    When you do not want to write the 'delete from array' function yourself, you could opt to implement the array C as an collection :

    dim c as collection

    c.add a(item)
    c.remove(random selected item number)

    for more information on using collections, visit
    blogspot forum

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Better Security Awareness With Threat Intelligence

    See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

    Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
    Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
    The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
    This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

    758 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    11 Experts available now in Live!

    Get 1:1 Help Now