Picking 2 names at random and not repeating them

[nkw2306]

Hi. I have a list of 51 names at the moment and I want it to pick 2 names art random and then do the same until all have been paired with someone else. I've found a macro that will pick random names but how do I get it to them pick another 25 names that are different to pair with the previous 25 names?

Macro used is

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 = Range("C1").Value
CellsOut = 2

ReDim Names(1 To HowMany) 'Set the array size to how many names required
NoOfNames = Application.CountA(Range("A:A")) - 1 ' 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, 2) = Names(ArI)
CellsOut = CellsOut + 1

Next ArI

Application.ScreenUpdating = True

End Sub

Any help is appreciated!

 

[nkw2306]

Solved elsewhere Thank you

 

[Fluff]

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.

Can you please the link, thanks