Thanks:  0
Likes:  0

1. I need to select 20 questions from a group of 100. It needs to be random and none repeating.

Any suggestions?

Thanks

2. Enter =RAND() in a column (e.g., B) for each question. Use =RANK(B1,B:B) in a column (e.g., C) for each question. Filter on column C for ranks <=20.

3. This program will give you 20 random integers between 1 through 100 in cells a1-a20. If you get a duplicate, run it again. Word to the wise, it's a little pokey, give her a minute or two:

Sub Ran()
Application.ScreenUpdating = False
[a1:a20].Select
For Each cell In Selection
ActiveCell = Int((100 * Rnd) + 1)
ActiveCell.Offset(1, 0).Select
Next cell
[a1].Select
Application.ScreenUpdating = True

End Sub

Cheers, Nate

[ This Message was edited by: NateO on 2002-03-14 11:08 ]

4. Thanks Mark W.

It works great!

5. One, if so inclined, could layer on a second procedure to ensure uniqueness:

Code:
```Option Explicit
Private upr As Integer
Private lwr As Integer

Sub Ran()
Dim cell As Range
upr = 100 'upper integer limit
lwr = 1   'lower integer limit
Application.ScreenUpdating = False
[a1:a20].Select
For Each cell In Selection
Randomize
ActiveCell = Int((upr - lwr + 1) * Rnd + lwr)
Call tstdup
ActiveCell.Offset(1, 0).Select
Next cell
[a1].Select
Application.ScreenUpdating = True
End Sub

Private Sub tstdup()
Dim LastRow As Integer
Dim c As Range
Dim myrng As Range
Dim SearchValue As String
LastRow = ActiveCell.Row - 1
If LastRow = 0 Then Exit Sub
Set myrng = Range("a1:a" & LastRow)
SearchValue = ActiveCell.Value
With Range("A1:A" & LastRow)
Set c = .Find(what:=SearchValue, LookIn:=xlValues, lookat:=xlWhole)
End With
If Not c Is Nothing Then
ActiveCell = Int((upr - lwr + 1) * Rnd + lwr)
Call tstdup
End If
Set myrng = Nothing
Set c = Nothing
End Sub```

Cheers, NateO

[ This Message was edited by: NateO on 2002-03-14 15:03 ]

## User Tag List

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•