I have some code (thanks to the author) that picks a list of random numbers in Col A (Starts in A6) and puts (copy) the list in Col D (Starts in D6), which works great. However there are 2 tweaks that I would like to make in the code...
1) instead of just copying the value in Col A to Col D, I would like to copy Col A:C to Col D:F,
2) and since I need to run the macro again, I need to get a new list that doesn't have the numbers in it from the first time it ran, so each time I run the macro, I need to clear the chosen numbers in Col A that were a Match to Col D.
So to reiterate...
Row 5 is the header row
Row 6 starts the data rows
Col A:C is the big list
Col A is a number, B:C are text
Col D is where the random list gets generated
Would like Col A:C to be generated in Col D:F
Would like Row (only Col A:C) to be cleared if Col D number matches Col A number.
Hope that makes sense.....
Here is the code I'm using:
Thanks in Advance,
Don
1) instead of just copying the value in Col A to Col D, I would like to copy Col A:C to Col D:F,
2) and since I need to run the macro again, I need to get a new list that doesn't have the numbers in it from the first time it ran, so each time I run the macro, I need to clear the chosen numbers in Col A that were a Match to Col D.
So to reiterate...
Row 5 is the header row
Row 6 starts the data rows
Col A:C is the big list
Col A is a number, B:C are text
Col D is where the random list gets generated
Would like Col A:C to be generated in Col D:F
Would like Row (only Col A:C) to be cleared if Col D number matches Col A number.
Hope that makes sense.....
Here is the code I'm using:
Code:
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
Worksheets("PPM").Range("D:D").ClearContents
Application.ScreenUpdating = False
HowMany = Range("F1").Value
CellsOut = 6
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, 4) = Names(ArI)
CellsOut = CellsOut + 1
Next ArI
Application.ScreenUpdating = True
End Sub
Thanks in Advance,
Don