Pick value from array at random

Luke777

Board Regular
Joined
Aug 10, 2020
Messages
243
Office Version
  1. 365
Platform
  1. Windows
Hi all,

With a lot of help from the forum, I've got myself an array containing cell addresses.

My next step in handling this data would be to pick from this list of addresses at random. I need to be able to control how many are picked (only likely to be 1 to 2 addresses) and for those picks to be unique in the case of 2 picks.

I'm not actually sure if this is possible or not - though I assume there must be a way of fudging it even if VBA isn't designed to do anything at random.

I'm imagining some sort of randbetween the ubound and lowbound of myArray - but I'm not sure on much beyond that.

Thanks all!

Edit: Should probably explain what I'm trying to do with the random cell address/addresses once they've been picked. They'll be given a .value from another variable - if its two picks, they're both the same .value:)
 
Last edited:

Excel Facts

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
VBA Code:
Sub RandomPick()
     rand = WorksheetFunction.RandArray(10)                     'suppose your array has 10 elements
     For i = 1 To UBound(rand)                                  'how many times do you want to pick ?
          r = Application.Match(Application.Small(rand, i), rand, 0)
          s = s & ", " & r
          MsgBox r                                              'random pick
     Next
     MsgBox Mid(s, 2)                                           '10 picks
End Sub
 
Upvote 0
VBA Code:
Sub RandomPick()
     rand = WorksheetFunction.RandArray(10)                     'suppose your array has 10 elements
     For i = 1 To UBound(rand)                                  'how many times do you want to pick ?
          r = Application.Match(Application.Small(rand, i), rand, 0)
          MsgBox r                                              'random pick
     Next
End Sub
Hi, thank you for your response!

I'm not great with arrays - would an element be, in my case, a single cell address? If so, how do I handle a variable number of cell addresses/elements?

The array I have currently is called myArray() - though I believe I should be able to plug what you've suggested in without having too much of a meltdown :)
 
Upvote 0
how does your array look like ?
arr=range("A1:Z100").value or arr=array("$a$1","$b$10", ....) or what ?
 
Upvote 0
how does your array look like ?
arr=range("A1:Z100").value or arr=array("$a$1","$b$10", ....) or what ?
the cell addresses are put into the array by testing cells in a range for a particular string. If they contain the string they get added to the array. Currently the array looks like "$C$5","$D$5","$E$5","$F$5","$G$5". But these addresses will vary and the number of addresses will also vary.
 
Upvote 0
Is your array one or two dimensional?
I’m sorry, I’m not too sure how to answer that as I’m inexperienced and a little out of my depth with arrays. The results/elements in the array will always be the same row of that helps?

Basically my array is populated by running an if test for each cell in a given row. If the result is positive, the cell address of the positive result gets added to the array.

The array will be cleared before running the test on any other rows
 
Upvote 0
start with value 1 in this line when your addresses are like in #5
VBA Code:
   If 1 Then GoTo Not_Special                                 'no special treatment
otherwise make that 1 a 0 when your addresses aren't always single cell addresses.
Now a little bit further, you can choose for unique or not unique addresses (even if a cell is multiple times in your array, it 'll result in 1 address or not)
VBA Code:
               If 1 Then                                        'choose 1 of not unique or 0 or unique !!!
also choose here a 1 or a 0

VBA Code:
Sub RandomPick()

     Number_Of_Picks = 3

     arr = Array("$C$5", "$D$5", "$E$5", "$F$5", "$G$5", "C3:F10")     'your array
     arr1 = arr

     If 1 Then GoTo Not_Special                                 'no special treatment

     Set dict = CreateObject("scripting.dictionary")
     For i = 0 To UBound(arr)
          For Each c In Range(arr(i)).Cells                     'make it an array and loop through the individual cells
               If 1 Then                                        'choose 1 of not unique or 0 or unique !!!
                    dict.Add dict.Count, c.Address              'not unique addresses
               Else
                    dict(c.Address) = c.Address                 'unique addresses
               End If
          Next
     Next

     arr1 = dict.items

Not_Special:

     If UBound(arr1) = 0 Then MsgBox "not enough elements": Exit Sub
     rand = WorksheetFunction.RandArray(UBound(arr1) + 1)       'suppose your array has 10 elements
     For i = 1 To Application.Min(Number_Of_Picks, UBound(rand))     'how many times do you want to pick ?
          r = Application.Match(Application.Small(rand, i), rand, 0)
          s = s & ", " & arr1(r - 1)
     Next
     MsgBox "My Picks : " & vbLf & Number_Of_Picks & vbLf & Mid(s, 3) & vbLf & vbLf & "My Options : " & vbLf & UBound(arr1) + 1 & vbLf & Join(arr1, ", ")
End Sub
 
Upvote 0
Another way.

VBA Code:
Option Explicit
Sub RandArray()
    Dim arrIn, arrList, arrOut, str As String
    Dim i As Long
    Const picks = 1     '<<<~~ This is where you can change 1 to 2 (number of picks)
    arrIn = Array("$C$5", "$D$5", "$E$5", "$F$5", "$G$5")
    
    Set arrList = CreateObject("System.Collections.ArrayList")
    For i = 0 To UBound(arrIn)
        str = Application.RandBetween(10, 99) & arrIn(i)
        arrList.Add str
    Next i
    
    arrList.Sort
    arrOut = arrList.ToArray
    
    For i = LBound(arrOut) To UBound(arrOut)
        arrOut(i) = Mid(arrOut(i), 3)
    Next i
    
    If picks = 1 Then
        MsgBox "My one pick is " & arrOut(1)
    ElseIf picks = 2 Then
        MsgBox "My first pick is " & arrOut(1) & vbNewLine & vbNewLine _
        & "My second pick is " & arrOut(2)
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,212,929
Messages
6,110,740
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top