4

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.

2
  • I'm not able to replicate, although there are/were some known limitations of the Rand() function, which is a pseudo-random number. Do you need to use the worksheet function "=Rand()" or could you use the VB function Rnd(), i.e., Range("C1").Value = Rnd()? I am not sure if that would make a difference, but would be worth trying. Jun 11, 2013 at 14:50
  • 1
    More info here Jun 11, 2013 at 14:52

1 Answer 1

8

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.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.