Rand pick from 4 pools

[SEMME]

I have been using the RAND and Vlookup functions for the following without success.
Any suggestions,

I have 4 numeric Pools or Groups;
1. A1:A18 (1-18)
2. B1:B18 (19-36)
3. C1:C17 (37-53)
4. D1:D17 (54-70)

I also have E1:E20 (20 existing Numbers from 1-70)

I want Excel to select at random a total of 20 numbers
and place them in F1:F20.

I will specify a quantity from each of the 4 groups.
Eg.
In cell A20 I enter 4 to obtain 4 numbers from grp 1,
In cell B20 I enter 6 to obtain 6 numbers from grp 2,
In cell C20 I enter 8 to obtain 8 numbers from grp 3,
In cell D20 I enter 2 to obtain 4 numbers from grp 4,

However there must not be any duplicates between
E1:E20 and F1:F20!

Thanx for your offering,
Semme

 

[SEMME]

Salut PCL,

Thank you for your correspondance.
Your latest explaination was clear and very detailed, so that I am
confidant that I prepared my sheet and code properly.

I have found that the results in F1:F20 have some duplicates with E1:E20.
The very frist code with two column randomn selections was perfectly fine.

Also is it neccessary to clear contents in E1:E20 each time?
I would prefer that it does not clear, so that I may do
a new random selection in F1:F20, repeatedly?

Regards,
Semme

 

[PCL]

Semme,
If you don't want to reset E1:E20 just remove next code or put a ' at the beginning to turn it in comment.

'    Range("E1:E20").ClearContents

Concerning duplicates , so far I did not see any.
Did you change the 2 statements for Group3 and 4 as mentioned in the last answer.
What you can do is to install next formula somewhere, it 's checking duplicate, the result allways must be 0.

=SUM(NOT(ISERROR(MATCH(F1:F20,E$1:E$20,0)))*1)

To finish you use next code which is doing the same as the previous one in a smarter way: Use of subroutine
Have a nice day

Option Explicit
Sub Random_Number3()
Dim NB_Nb_GRP1  As Integer
Dim NB_Nb_GRP2  As Integer
Dim NB_Nb_GRP3  As Integer
Dim NB_Nb_GRP4  As Integer
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim MyRANGE As Range
Dim F As Object
Dim GRP1_Select2 As Integer
Dim GRP2_Select2 As Integer
Dim GRP3_Select2 As Integer
Dim GRP4_Select2 As Integer
    GRP1_Select2 = Range("GRP1_Select2")
    GRP2_Select2 = Range("GRP2_Select2")
    GRP3_Select2 = Range("GRP3_Select2")
    GRP4_Select2 = Range("GRP4_Select2")
'------   CLEANING  PREVIOUS  RESULT   ------
'    Range("E1:E20").ClearContents
    Range("F1:F20").ClearContents
    
'------   PREPARE  FIRST  AREA   -------
    J = 1
    NB_Nb_GRP1 = WorksheetFunction.CountA(Range("Grp1_Select1"))
    For I = 1 To NB_Nb_GRP1
        Cells(J, "E") = Range("Grp1_Select1").Cells(I, 1)
        J = J + 1
    Next I
    NB_Nb_GRP2 = WorksheetFunction.CountA(Range("Grp2_Select1"))
    For I = 1 To NB_Nb_GRP2
        Cells(J, "E") = Range("Grp2_Select1").Cells(I, 1)
        J = J + 1
    Next I
    NB_Nb_GRP3 = WorksheetFunction.CountA(Range("Grp3_Select1"))
    For I = 1 To NB_Nb_GRP3
        Cells(J, "E") = Range("Grp3_Select1").Cells(I, 1)
        J = J + 1
    Next I
    NB_Nb_GRP4 = WorksheetFunction.CountA(Range("Grp4_Select1"))
    For I = 1 To NB_Nb_GRP4
        Cells(J, "E") = Range("Grp4_Select1").Cells(I, 1)
        J = J + 1
    Next I
    K = 1
    Call Treatment(K, "GRP1_Data", 18, NB_Nb_GRP1, GRP1_Select2)
    Call Treatment(K, "GRP2_Data", 18, NB_Nb_GRP2, GRP2_Select2)
    Call Treatment(K, "GRP3_Data", 17, NB_Nb_GRP3, GRP3_Select2)
    Call Treatment(K, "GRP4_Data", 17, NB_Nb_GRP4, GRP4_Select2)
End Sub
    
    
Sub Treatment(K As Integer, GRP_Data As String, NB_Val As Integer, NB_Nb_GRP As Integer, GRP_Select2 As Integer)
Dim IPRES
Dim MyRANGE As Range
Dim I As Integer
Dim J As Integer
Dim F As Object
    Set MyRANGE = Range("E1:E20")
'------   PREPARE  RANDOM  AREA  with  GROUP  -------
    J = 1
    With MyRANGE
        Range("Working_Range").Offset(, 1).ClearContents      '----  CLEAN  UP  PREVIOUS  DATA
        For Each F In Range(GRP_Data)
            Set IPRES = .Find(F, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
            If (IPRES Is Nothing) Then
                Range("Working_Range").Cells(J, 2) = F.Value
                J = J + 1
            End If
        Next F
     End With
     
'-------    RANDOMIZE  ORDER  GROUP   -------
    With Range("Working_Range")
        With Range(.Cells(1, 1), .Cells(NB_Val - NB_Nb_GRP, 2))
            .Sort Key1:=.Offset(0, 0), Order1:=xlAscending, Header:=xlGuess, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
            DataOption1:=xlSortNormal
        End With
        
'-------   COPY  DATA  IN SECOND  AREA   -------
        For I = 1 To GRP_Select2
            Cells(K, "F") = .Cells(I, 2)
            K = K + 1
        Next I
    End With
End Sub

 

[SEMME]

Pat, et la voila, c'est magnifique! hors de mes expectatives!
More than I anticipated! The Board structure you created in "L:O"
gave me other ideas to improve my goal!
Also brilliant was the selection top to bottom and vise versa!!


Merci, et vive la.....
Semme