I'm working on a macro that selects a random series of employee id numbers for random testing. The code I have works well except the first number returned is always the same. For example, if my ID numbers are 1-100 and I want 10 random numbers, the first number will always be 1 and then at random after that.
As an extra challenge, is it possible to make it where the same numbers won't be selected until the list has been cycled through?
Here is the code that I'm using.
Sub Macro1()
'
'
'
'
Dim CountCells
Dim RandCount
Dim LastRow
Dim Counter1
Dim Counter2
Worksheets.Add().Name = "Sheet1"
Worksheets("Employee ID#").Select
Range("a2:A431").Select
Selection.Copy
Worksheets("Sheet1").Select
Selection.PasteSpecial
Worksheets("Sheet1").Select
Range("A1").Select
CountCells = WorksheetFunction.Count(Range("A:A")) 'quantity of random numbers to pick from
If CountCells = 0 Then Exit Sub
On Error Resume Next
Application.DisplayAlerts = False
RandCount = Application.InputBox(Prompt:="How many random numbers do you want?", _
Title:="Random Numbers Selection", Type:=1)
On Error GoTo 0
Application.DisplayAlerts = True
RandCount = Int(RandCount)
If Int(RandCount) <= 0 Or RandCount = False Then Exit Sub
If RandCount > CountCells Then
MsgBox "Requested quantity of numbers is greater than quantity of available data"
Exit Sub
End If
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'clear working area
Range("B:C").ClearContents
'clear destination area
Range("Sheet2!A:A").ClearContents
'create index for sort use
Range("B1") = 1
Range(Cells(1, 2), Cells(LastRow, 2)).DataSeries , Step:=1
'create random numbers for sort
Range("C1") = "=RAND()"
Range("C1").Copy Range(Cells(1, 3), Cells(LastRow, 3))
'randomly sort data
Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'data has been sorted randomly, cells in column A, rows 1 through the quantity desired will be chosen
Counter1 = 1
Counter2 = 1
Do Until Counter1 > RandCount
If IsNumeric(Cells(Counter2, 1).Value) And Cells(Counter2, 1).Value <> Empty Then
Range("Sheet2!A" & Counter1) = Cells(Counter2, 1).Value
Counter1 = Counter1 + 1
'Selection.ClearContents
End If
Counter2 = Counter2 + 1
Loop
'resort data into original order and clear working area
Range(Cells(1, 1), Cells(LastRow, 3)).Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Range("B:C").ClearContents
Sheets("Sheet2").Select
'Sheets("Sheet2").PrintOut
End Sub
Thanks in advance for any help.
To get a different first number, simply add a line that says Randomize
at the start of your function.
You could load the list of employees into an array and then when one is selected, remove the employee from the array so they can't be selected again.
-Edit-
I came up with this bit of code that should work for you. It loads the employee ID#s into an array so you don't have to deal with selecting and rearranging cells which is a slow operation. The code then picks employees from the array of all the employees and adds them to an array of employees to check. It then removes the employee from the array of all the employees so that they cannot be picked again. Once the code has selected the needed number of employees to check, it writes them into the desired sheet.
Sub SelectRandomEntries()
Dim WSEmp As Worksheet
Dim WSCheckedEmps As Worksheet
Dim AllEmps() As Long 'An array to hold the employee numbers
'Assuming Column A is an integer employee #
Dim CheckedEmps() As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim RandCount As Long
Dim RandEmp As Long
Dim i As Long
'Set the worksheets to variables. Make sure they're set to the appropriate sheets in YOUR workbook.
Set WSEmp = ThisWorkbook.Worksheets("Employee ID#") 'Sheet with all employees
Set WSCheckedEmps = ThisWorkbook.Worksheets("Checked Employees") 'Sheet with checked employees
FirstRow = 1
LastRow = WSEmp.Cells(WSEmp.Rows.Count, "A").End(xlUp).Row 'Find the last used row in a ColumnA
Randomize 'Initializes the random number generator.
'Load the employees into an array
ReDim AllEmps(FirstRow To LastRow) 'Make the array large enough to hold the employee numbers
For i = FirstRow To LastRow
AllEmps(i) = WSEmp.Cells(i, 1).Value
Next
'For this example, I sent RandCount to a random number between the first and last entries.
'Rnd() geneates a random number between 0 and 1 so the rest of line converts it to a usable interger.
RandCount = Int((LastRow - FirstRow + 1) * Rnd() + FirstRow)
MsgBox (RandCount & "will be checked")
ReDim CheckedEmps(1 To RandCount)
'Check random employees in the array
For i = 1 To RandCount
RandEmp = Int((LastRow - FirstRow + 1) * Rnd() + FirstRow) 'pick a random employee to check
If IsNumeric(AllEmps(RandEmp)) And AllEmps(RandEmp) <> Empty Then 'If the emp# is valid
CheckedEmps(i) = AllEmps(RandEmp) 'Move the employee to the checked employee list.
AllEmps(RandEmp) = Empty 'Clear the employee from the full list so they can't get picked again
Else
i = i - 1 'If you checked a RandEmp that wasn't suitable, you'll need to check another one.
End If
Next
'Write the employees to the results sheet
For i = 1 To RandCount
WSCheckedEmps.Cells(i, 1) = CheckedEmps(i)
Next i
End Sub
You may need to add checks that are relevant specifically to your data set (I just used a handful of random integers) and you'll want to re-implement a way for people to choose how many employees to check.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With