Error Checking in Excel
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 5 of 5

Thread: Random Number generation to create a cup draw

  1. #1
    New Member
    Join Date
    Mar 2002
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Aim is to create a random cup draw.

    I enter 32 players names in cells A1 - A32

    I want to generate random numbers between 1 and 32. At no time should any random number generated be repeated.

    In addition when each random number is generated I want it to recognise a players name and copy his name into say cell C1.

    The next random number generated should follow the above process but this players name should be copied in cell E1.

    Next name to cell C2, followed by cell E2 and so on until we have 16 players names in cells C1-C16 and 16 players names in cells E1-E16

  2. #2

    Join Date
    Feb 2002
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Try this :-

    Sub Randomize_List()
    Application.ScreenUpdating = False
    [A1:A32].Copy [C1]
    Columns("C:D").Insert
    [D1:D32].FormulaR1C1 = "=RAND()"
    [D1:E32].Sort Key1:=[D1], Header:=xlNo
    [D1:D32].Value = [D1:D32].Value
    [C1:C32].FormulaR1C1 = "=IF(MOD(ROW(),2)<>0,1,2)"
    [C1:C32].Value = [C1:C32].Value
    [C1:E32].Sort Key1:=[C1], Header:=xlNo
    [E17:E32].Cut
    ActiveSheet.Paste Destination:=[G1]
    Columns("C:D").Delete
    End Sub





    [ This Message was edited by: Escalus on 2002-03-08 02:35 ]

  3. #3
    Rest in Peace
    Join Date
    Feb 2002
    Posts
    1,582
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hi mcconns

    Here is some that will create random numbers for.


    Sub RandomNumberGenerator()
    'Creates a list of random numbers _
    between 1 and 36 in range A1:F6
    'Written by OzGrid Business Applications
    'www.ozgrid.com
    Dim Rw As Integer, Col As Integer
    Dim Reply1 As Long, Reply2 As Long, Reply3 As Long
    Dim lSqR As Long
    Dim lSqC As Long
    Dim i As Long, lRand As Long
    On Error Resume Next




    Above:
    Reply2 = 0
    Reply2 = InputBox("Lowest number ?" _
    & Chr(13) & Chr(13) & "Number must be greater than 0 and entered without spaces or commas" & Chr(13) _
    , "OzGrid Random Number Generator", 1)
    If Reply2 = 0 Then Exit Sub

    If Reply2 < 1 Then
    MsgBox "Number must be greater than 0", vbCritical, "OzGrid Business Applications"
    GoTo Above
    End If

    Above2:
    Reply3 = 0
    Reply3 = InputBox("Highest number ? " _
    & Chr(13) & Chr(13) & "Number must be greater than " & Reply2 & " and entered without spaces or commas" & Chr(13) _
    , "Lowest number = " & Reply2, 500)
    If Reply3 = 0 Then Exit Sub

    If Reply3 <= Reply2 Then
    MsgBox "Number must be greater than " & Reply2, vbCritical, "OzGrid Business Applications"
    GoTo Above2
    End If


    HowMany:
    Reply1 = 0
    Reply1 = InputBox("How many random numbers do you wish to generate?" _
    & Chr(13) & Chr(13) & "Number must be whole and less than 1000" & Chr(13) _
    & Chr(13) & "An amount greater than 500 within a tight band will take some time!" _
    & Chr(13) & "Numbers will be sorted Left to Right by row" _
    , "Lowest number = " & Reply2 & " Highest number = " & Reply3, 200)
    If Reply1 = 0 Then Exit Sub

    If Reply1 > 1000 Then
    MsgBox "Number must be less than 1000", vbCritical, "OzGrid Business Applications"
    GoTo HowMany:
    End If

    If Reply1 > Reply3 - Reply2 Then
    MsgBox "Not possible.", vbCritical, "OzGrid Business Applications"
    GoTo HowMany:
    End If

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Sheets.Add().Name = "Random Numbers"
    If ActiveSheet.Name <> "Random Numbers" Then
    ActiveSheet.Delete
    Sheets("Random Numbers").Select
    Cells.Clear
    End If
    Dim sCheck As String
    Range("A1") = Reply1

    Range("B1").FormulaR1C1 = "=ROUNDUP(SQRT(RC[-1]),0)"




    lSqR = Range("B1")
    lSqC = lSqR

    On Error GoTo 0
    'Clear the range ready for random numbers
    Range("A1:IV600").Clear

    Randomize ' Initialize random-number generator.
    For Col = 1 To lSqC 'Set the Column numbers
    If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For
    For Rw = 1 To lSqR 'Set the Row numbers
    If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For

    'Cells(Rw, Col) = Int((Reply3 - Reply2 + 1) * Rnd + Reply2)

    Do Until WorksheetFunction.CountIf _
    (Cells, Cells(Rw, Col)) = 1
    Cells(Rw, Col) = Int((Reply3 - Reply2 + 1) * Rnd + Reply2)
    Loop
    If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For
    Next Rw
    If WorksheetFunction.CountA(Cells) = Reply1 Then Exit For
    Next Col

    Rw = 1
    For Rw = 1 To ActiveSheet.UsedRange.Rows.Count
    Rows(Rw).Sort Key1:=Rows(Rw).Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight
    Next Rw
    Application.Goto Range("A1"), True

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    End Sub

  4. #4
    MrExcel MVP
    Join Date
    Feb 2002
    Location
    Newcastle, UK
    Posts
    1,174
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Here's a formula solution,

    in A1:A32 put:

    =Rand() (place in A1 & copy down)

    in B1:B32 put:

    =RANK(A1,$A$1:$A$32)+COUNTIF(B$1:B1,B1)-1
    Exactly as it's writtem with the $'s in the same places.

    in C1 put:

    your Players Names

    Now in any column you want (I'm using E), put the numbers 1 - 16, then 2 columns along from that (G for me) put 17 - 32.

    now all you need to do is use vlookup in cols F + H on the table you've just created range B1:C32.

    the easiest way is to put:

    =VLOOKUP(E1,$B$1:$C$32,2,0)

    in F1 and copy down. then copy paste F1:F16 into H1:H16. (again make sure the $'s are in the right place).

    you can now hide Cols B,C,E and G. Every time you press Del, F9 or recalc the sheet you'll get a random list of matches.

    Hope this helps.
    "Have a good time......all the time"
    Ian Mac

  5. #5

    Join Date
    Feb 2002
    Posts
    12
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    On 2002-03-08 04:46, Ian Mac wrote:
    Here's a formula solution,

    in A1:A32 put:

    =Rand() (place in A1 & copy down)

    in B1:B32 put:

    =RANK(A1,$A$1:$A$32)+COUNTIF(B$1:B1,B1)-1
    Exactly as it's writtem with the $'s in the same places.

    in C1 put:

    your Players Names

    Now in any column you want (I'm using E), put the numbers 1 - 16, then 2 columns along from that (G for me) put 17 - 32.

    now all you need to do is use vlookup in cols F + H on the table you've just created range B1:C32.

    the easiest way is to put:

    =VLOOKUP(E1,$B$1:$C$32,2,0)

    in F1 and copy down. then copy paste F1:F16 into H1:H16. (again make sure the $'s are in the right place).

    you can now hide Cols B,C,E and G. Every time you press Del, F9 or recalc the sheet you'll get a random list of matches.

    Hope this helps.
    The macro I posted is also based on recorded code from the following :-

    - Players names in A1:A32
    - Copy players names to C1:C32
    - Insert 2 columns before column C
    - In D1:D32 enter =RAND()
    - Convert D1:D32 to values
    - Select D1:E32 and sort
    - In C1:C32 enter =IF(MOD(ROW(),2)<>0,1,2)
    - Convert C1:C32 to values
    - Select C1:C32 and sort
    - Cut E17:E32 and paste to G1
    - Delete columns C:D

Some videos you may like

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
  •