Help editing VBA code to pick 3 names randomly from a list of names

[cjms85]

Hi all,

I'm trying to write/adapt some VBA code that can pick 3 randomly pick names from a list. The must not pick the same name more than once.

I have a master list of names in column A. I have used another piece of code to pick a subset from this column (based on a separate criteria). This subset of names appears in column I. I would like to pick 3 names randomly from the subset of names in column I and output them to column J.

I have adapted the following code:

Option Explicit

Sub PickNamesAtRandom()


Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names() As String 'Array to store randomly selected names
Dim i As Byte
Dim CellsOut As Long 'Variable to be used when entering names onto worksheet
Dim ArI As Byte 'Variable to increment through array indexes


Application.ScreenUpdating = False


HowMany = 3
CellsOut = 1


ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("I:I")) ' Find how many names in the list
i = 1


Do While i <= HowMany
RandomNo:
    RandomNumber = Application.RandBetween(2, NoOfNames + 1)
    'Check to see if the name has already been picked
    For ArI = LBound(Names) To UBound(Names)
        If Names(ArI) = Cells(RandomNumber, 1).Value Then
            GoTo RandomNo
        End If
    Next ArI
    Names(i) = Cells(RandomNumber, 1).Value ' Assign random name to the array
    i = i + 1
Loop


'Loop through the array and enter names onto the worksheet
For ArI = LBound(Names) To UBound(Names)


    Cells(CellsOut, 10) = Names(ArI)
    CellsOut = CellsOut + 1


Next ArI


Application.ScreenUpdating = True


End Sub

The problem I'm having is that it's currently picking up the master list of values in column A and not the subset from column I. Can anyone work out what I've missed in the code?

Many thanks,
Chris

 

[Anthony47]

You use

    …  Cells(RandomNumber, 1) …

Obviously this get data from column 1=A; replace 1 with 9=I (in two lines)

And your code could be simplified, both in checking for duplicates and in writing the results on the sheet:

Sub PickNamesAtRandom()
Dim HowMany As Integer
Dim NoOfNames As Long
Dim RandomNumber As Integer
Dim Names() As String 'Array to store randomly selected names
Dim i As Byte
'
HowMany = 3         '<<< Your limit
'
ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("I:I")) ' Find how many names in the list
If HowMany > NoOfNames Then Exit Sub
i = 1
Do While i <= HowMany
    RandomNumber = Application.RandBetween(2, NoOfNames + 1)
    If IsError(Application.Match(Cells(RandomNumber, 9), Names, False)) Then
        Names(i) = Cells(RandomNumber, 9)
        i = i + 1
    End If
    DoEvents
Loop
'Dump Names:
Cells(1, 10).Resize(HowMany, 1) = Application.WorksheetFunction.Transpose(Names)
End Sub

Bye

 

[cjms85]

Hi Anthony47,

Thanks for updating/adapting the code. I'm still having a slight problem though. When I run the code you've changed, instead of always giving me 3 randomly selected names from a list, it gives me between 1 and 3 randomly selected names from a list. I would like it always to give me 3 names, but just randomly selected.

Here's a link to my file with the code.
https://drive.google.com/file/d/1T30tiRrszaLO3gp3lsTquVvAXNOxezFF/view?usp=sharing

Cheers,
Chris

 

[Rick Rothstein]

If you are willing to consider a different approach, the following macro should do what you are attempting to do...

Sub GetRandomNamesFromColumnI()
  Dim HowMany As Long, Cnt As Long, RandomIndex As Long
  Dim Tmp As Variant, Nmes As Variant
  HowMany = 1
  Nmes = Range("I1", Cells(Rows.Count, "I").End(xlUp))
  Randomize
  For Cnt = 1 To UBound(Nmes)
    RandomIndex = Int(Cnt * Rnd + 1)
    Tmp = Nmes(RandomIndex, 1)
    Nmes(RandomIndex, 1) = Nmes(Cnt, 1)
    Nmes(Cnt, 1) = Tmp
  Next
  Range("J1").Resize(HowMany) = Nmes
End Sub

 

[Anthony47]

RandomNumber = Application.RandBetween(2, NoOfNames + 1)

This portion of your code suggested to me that your list in column I starts on row 2, with row 1 empty.

If your list starts from Row 1 than you need to modify that line:

RandomNumber = Application.RandBetween(1, NoOfNames)

If your list has a header (not a name) on row 1:

RandomNumber = Application.RandBetween(2, NoOfNames)

@Rick, smart solution.

Bye