Random Interger
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 5 of 5

Thread: Random Interger

  1. #1
    Guest

    Default

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

    Any suggestions?

    Thanks

  2. #2
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Austin, Texas USA
    Posts
    11,654
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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. #3
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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. #4
    Guest

    Default

    Thanks Mark W.

    It works great!

  5. #5
    Legend NateO's Avatar
    Join Date
    Feb 2002
    Location
    Minneapolis, Mn, USA
    Posts
    9,700
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

      
    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

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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

 

 
DMCA.com