Random selection from list

Question

I have a list of items in an Excel worksheet, A1-B115. At the moment I can enter 10 variables which retrieves the correct data from the list.

Code now:

C1=1 - run through A1-A115 and check for the value to be between 1000-2000; if so, copy the B value somewhere.

C2=1 - run through A1-A115 and check for the value to be between 2001-3000; if so, copy the B value somewhere.

....

What I would like to do is that I can enter a value (example: 25 or 30) and that my macro randomly selects the right amount of values.

Code I would like to do: C1: 30 -> randomly selects 30 values from B1-B115

Answer 1

This will do the trick.

Sub PickRandomItemsFromList()

    Const nItemsToPick As Long = 10
    Const nItemsTotal As Long = 115

    Dim rngList As Range
    Dim varRandomItems() As Variant
    Dim i As Long

    Set rngList = Range("B1").Resize(nItemsTotal, 1)

    ReDim varRandomItems(1 To nItemsToPick)
    For i = 1 To nItemsToPick
        varRandomItems(i) = rngList.Cells(Int(nItemsTotal * Rnd + 1), 1)
    Next i
    ' varRandomItems now contains nItemsToPick random items from range rngList. 
End Sub

As discussed in the comments, this will allow individual items to be picked more than once within the nItemsToPick picked, if for example number 63 happens to be randomly picked twice. If you don't want this to happen, then an additional loop will have to be added to check whether the item about to be picked is already in the list, for example like so:

Sub PickRandomItemsFromList()

    Const nItemsToPick As Long = 10
    Const nItemsTotal As Long = 115

    Dim rngList As Range
    Dim idx() As Long
    Dim varRandomItems() As Variant
    Dim i As Long
    Dim j As Long
    Dim booIndexIsUnique As Boolean

    Set rngList = Range("B1").Resize(nItemsTotal, 1)

    ReDim idx(1 To nItemsToPick)
    ReDim varRandomItems(1 To nItemsToPick)
    For i = 1 To nItemsToPick
        Do
            booIndexIsUnique = True ' Innoncent until proven guilty
            idx(i) = Int(nItemsTotal * Rnd + 1)
            For j = 1 To i - 1
                If idx(i) = idx(j) Then
                    ' It's already there.
                    booIndexIsUnique = False
                    Exit For
                End If
            Next j
            If booIndexIsUnique = True Then
                Exit Do
            End If
        Loop
        varRandomItems(i) = rngList.Cells(idx(i), 1)
    Next i

    ' varRandomItems now contains nItemsToPick unique random 
    ' items from range rngList. 
End Sub

Note that this will loop forever if nItemsToPick > nItemsTotal !