Random draw of numbers.

marreco

Well-known Member
Joined
Jan 1, 2011
Messages
607
Hi.I have in column 'A' an amount of numbers per line.


I would like to generate column 'B' only 15 numbers without repeating.


example:
I have in column 'A' 50 different numbers.


necessary that in column 'B' is generated from the draw 15 numbers without repetition.

I could not adapt that code
Code:
Sub randomCollection()
    Dim Names As New Collection
    Dim lastRow As Long, i As Long, j As Long, lin As Long
    Dim wk As Worksheet
 
    Set wk = Sheets("Plan1")
 
    With wk
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
 
    For i = 2 To lastRow
        Names.Add wk.Cells(i, 1).Value, CStr(wk.Cells(i, 1).Value)
    Next i
 
    lin = 1
    For i = lastRow - 1 To 1 Step -1
        j = Application.WorksheetFunction.RandBetween(1, i)
        lin = lin + 1
        Range("B" & lin) = Names(j)
        Names.Remove j
    Next i
 
End Sub
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
Try something like this...

Code:
[color=darkblue]Sub[/color] randomCollection()


    [color=darkblue]Dim[/color] counter [color=darkblue]As[/color] [color=darkblue]Long[/color], a [color=darkblue]As[/color] [color=darkblue]Variant[/color], r [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]With[/color] Sheets("Plan1")
    
        a = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        
        [color=darkblue]Do[/color]
            r = Int((UBound(a) * Rnd) + 1)
            [color=darkblue]If[/color] WorksheetFunction.CountIf(.Range("B:B"), a(r, 1)) = 0 [color=darkblue]Then[/color]
                counter = counter + 1
                .Range("B" & counter + 1).Value = a(r, 1)
            [color=darkblue]End[/color] [color=darkblue]If[/color]
        [color=darkblue]Loop[/color] [color=darkblue]Until[/color] counter = 15
    [color=darkblue]End[/color] [color=darkblue]With[/color]


[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 

b.downey

Active Member
Joined
Oct 16, 2011
Messages
484
Here is the code:

Code:
Option Explicit
Sub randomCollection()
    Const N As Integer = 5
    Dim Used() As Boolean
    
    Dim lastRow As Long, NumCnt As Long, RndNo As Long
    Dim Ws As Worksheet
    
    Debug.Print "************"
    
    Set Ws = Sheets("Sheet2")
 
    lastRow = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
    ReDim Used(lastRow)
    
    NumCnt = 1
    
    Ws.Columns("B:B").ClearContents
    Do While NumCnt <= N
        RndNo = Application.WorksheetFunction.RandBetween(1, lastRow)
        If Not Used(RndNo) Then
            Used(RndNo) = True
            Ws.Cells(NumCnt, "B") = Ws.Cells(RndNo, 1)
            NumCnt = NumCnt + 1
        End If
    Loop
 
End Sub

The constant "N" has the number of numbers you what to select. I have it as 5 for testing, in your example, you have 15
 

JoeMo

MrExcel MVP
Joined
May 26, 2009
Messages
17,389
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Yet another approach:
Code:
Sub Draw15()
Dim R1 As Range, R2 As Range, d As Object, T As Integer, n As Integer

Set R1 = Range("A1:A50")
Set R2 = Range("B1:B15")
Set d = CreateObject("Scripting.Dictionary")
Do Until n >= 15
    T = Rnd * (50 - 1) + 1
    If Not d.exists(CStr(T)) Then
        n = n + 1
        d.Add CStr(T), n
        R2.Cells(n, 1).Value = T
    End If
Loop
End Sub
 

marreco

Well-known Member
Joined
Jan 1, 2011
Messages
607
Hi.
I'm very happy for the answers all of them solves my problem!


Thank you very much!
 

hurgadion

Active Member
Joined
Mar 19, 2010
Messages
426
Hi,
You can using the macro, too
Code:
Sub Ran()
Dim i&, tbl

tbl = RndInt()
For i = 1 To 15
  Cells(i, 2).Value = Cells(tbl(i), 1).Value
Next i
End Sub

Function RndInt()
Dim V() As Variant, Val As Variant
Dim i&, j&, r&, c&, a&
Dim t1 As Variant, t2 As Variant
Randomize
a = 50
ReDim V(1 To a)
ReDim Val(1 To 2, 1 To a)
For i = 1 To a
  Val(1, i) = Rnd
  Val(2, i) = i
Next i
For i = 1 To a
  For j = i + 1 To a
    If Val(1, i) > Val(1, j) Then
      t1 = Val(1, j)
      t2 = Val(2, j)
      Val(1, j) = Val(1, i)
      Val(2, j) = Val(2, i)
      Val(1, i) = t1
      Val(2, i) = t2
     End If
   Next j
 Next i
  
i = 0
For r = 1 To a
    i = i + 1
    V(i) = Val(2, i)
Next r
RndInt = V
End Function
The useful, subsidiary Function is WalkenBach's Function, best regards.
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,122,962
Messages
5,599,065
Members
414,281
Latest member
Engjamal2021

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top