اختيار عشوائي

Option Explicit

'+++++++++++++++++++++++++++++

Sub choos_randomly()

Dim i%, rd%, x%, _

    k%, y%, Lr%

Dim My_list As Object



If ActiveSheet.Name <> "Salim" Then Exit Sub

Set My_list = CreateObject("System.Collections.ArrayList")

Lr = Cells(Rows.Count, 1).End(3).Row

If Lr < 2 Then Exit Sub

Range("c2", Range("c1").End(4)).ClearContents

'===============================

 If [g2] <= 0 Or Not IsNumeric([g2]) Then

   MsgBox "You Choose a NEGATIVE Number ,Or ZER0 or Empty CELL" & Chr(10) & _

   "I Can't Help You", 1048640

   Exit Sub

 Else

 [g2] = Int([g2])

 End If

'=====================

   With My_list

      For i = 2 To Lr

       If Not .Contains(Range("a" & i).Value) Then

    .Add Range("a" & i).Value

        End If

      Next

       y = .Count

    .Clear

  End With

  If [g2] > y Then

   MsgBox "You Choose an Impossible number" & Chr(10) & _

   " Please Enter a Number <= than " & y, 1048640

   [g2] = vbNullString

   Exit Sub

   End If

     

  '======================

k = 0

With My_list

    Do Until k = [g2]

      If k = y Then Exit Do

     x = (Lr) * Rnd: If x < 2 Then x = 2

        If Not .Contains(Range("a" & x).Value) Then

 .Add Range("a" & x).Value

       k = k + 1

       End If

    Loop

    Range("c2").Resize(.Count) _

    = Application.Transpose(.toarray)

 .Clear

End With



 End Sub