Random draw of numbers.

[marreco]

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

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

 

[AlphaFrog]

Try something like this...

[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]

Here is the 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]

Yet another approach:

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]

Hi.
I'm very happy for the answers all of them solves my problem!


Thank you very much!

 

[hurgadion]

Hi,
You can using the macro, too

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.