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

 

[PCL]

If there is NO duplicate between E1:E20 and F1:F20;
if E1:E20 are coming from 1 to 70; F1:F20 are coming from the remaining numbers from 1 to 70 minus numbers from E1:E20 --> 50 numbers.
Is it possible to pick up 4 of these numbers from Group1, 6 from Group2 etc...
Could you give an example for the groups and for E1:E20.

 

[SEMME]

Bonjour PCL,

Thanks for offering to help and You are correct, F1:F20 are 20 other numbers, chosen from the remaining 50 (70 Less the the 20 in E1:E20 = 50 nos).

EXAMPLE: E1:E20 will contain numbers from 1-70 randomly chosen manually.

1,2,17 ..... 3 from 1. A1:A18 (1-18)
19,20,32,35,36..... 5 from 2. B1:B18 (19-36)
38,46,47..... 3 from 3. C1:C17 (37-53)
54,55,56,57,58,59,61,69,70,..... 9 from 4.D1:D17 (54-70)

The results in F1:F20 that I'm looking for are a random selection from the remaining 50-basically any combination other than than the above but according to the specified quantity I select.

So I may want 3 from Grp.1
I may want 7 from Grp.2
I may want 5 from Grp.3
I may want 5 from *Grp.4
TOTAL 20 numbers always!

*(obviously from this group I could not ask for more than 8, because 9 out of 17 were already present in E1:E20)

Excel would return the following:

6,7,18..... 3 from grp1. A1:A18 (1-18)
21,22,23,26,29,30,34...... 7 from grp2. B1:B18 (19-36)
39,41,48,49,51 ..... 5 from grp3. C1:C17 (37-53)
63,65,66,67,68..... 5 from grp4. D1:D17 (54-70)

These numbers were generated at random for F1:F20 from all 4 groups.

In effect the macro will continue to give me combinations each time it runs.

I have been looping random numbers with conditions hoping to get the results,
but the calculations take a very,very long time.

Hope it is a little more clear and that you can help,
thx
Semme

 

[PCL]

Let see how next code can work.
File must be prepare as follow, you will adapt it.
Group1: B1:B18
Group2: C1:C18
Group3: E1:E18
Group4: F1:F18
From A1 to A18 put =RAND()
From D1 to D17 put =RAND()
Let's name Grp1_Select1, Grp2_Select1, Grp3_Select1, Grp4_Select1 where to inform numbers to fill to previous column E
Grp1_Select1 + Grp2_Select1 + Grp3_Select1 + Grp4_Select1 =20

Let's name Grp1_Select2, Grp2_Select2, Grp3_Select2, Grp4_Select2
where to inform numbers to fill to previous column F
Grp1_Select2 + Grp2_Select2 + Grp3_Select2 + Grp4_Select2 =20
Selection 1 is done from the TOP of the groups and selection2 from the BOTTOM.

Grp1_Select1 + Grp1_Select2 <= 18
Grp2_Select1 + Grp2_Select2 <= 18
Grp3_Select1 + Grp3_Select2 <= 17
Grp4_Select1 + Grp4_Select2 <= 17
All groups are rearanged using random numbers on side of each group.

Option Explicit
Option Base 1    ' Set default array subscripts to 1.
Sub Random_Number()
Dim GRP1_Select1 As Integer
Dim GRP2_Select1 As Integer
Dim GRP3_Select1 As Integer
Dim GRP4_Select1 As Integer
Dim GRP1_Select2 As Integer
Dim GRP2_Select2 As Integer
Dim GRP3_Select2 As Integer
Dim GRP4_Select2 As Integer
Dim I As Integer
Dim J As Integer
'-------    READ  DATA  SELECTION   -------
    GRP1_Select1 = Range("GRP1_Select1")
    GRP2_Select1 = Range("GRP2_Select1")
    GRP3_Select1 = Range("GRP3_Select1")
    GRP4_Select1 = Range("GRP4_Select1")
 
    GRP1_Select2 = Range("GRP1_Select2")
    GRP2_Select2 = Range("GRP2_Select2")
    GRP3_Select2 = Range("GRP3_Select2")
    GRP4_Select2 = Range("GRP4_Select2")
 
'-------    RANDOMIZE  ORDER  GROUPE  1  AND  2   -------
    With Range("A1:C18")
        .Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With
'-------    RANDOMIZE  ORDER  GROUPE  3  AND  4   -------
    With Range("D1:F17")
        .Sort Key1:=Range("D1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    End With
'-------    FILL  DATA  IN  BANK 1   -------
    J = 1
    For I = 1 To GRP1_Select1
        Cells(J, "H") = Cells(I, "B")
        J = J + 1
    Next I
    For I = 1 To GRP2_Select1
        Cells(J, "H") = Cells(I, "C")
        J = J + 1
    Next I
    For I = 1 To GRP3_Select1
        Cells(J, "H") = Cells(I, "E")
        J = J + 1
    Next I
    For I = 1 To GRP4_Select1
        Cells(J, "H") = Cells(I, "F")
        J = J + 1
    Next I
'-------    FILL  DATA  IN  BANK 2   -------
    J = 1
    For I = 1 To GRP1_Select2
        Cells(J, "I") = Cells(18 - I + 1, "B")
        J = J + 1
    Next I
    For I = 1 To GRP2_Select2
        Cells(J, "I") = Cells(18 - I + 1, "C")
        J = J + 1
    Next I
    For I = 1 To GRP3_Select2
        Cells(J, "I") = Cells(17 - I + 1, "E")
        J = J + 1
    Next I
    For I = 1 To GRP4_Select2
        Cells(J, "I") = Cells(17 - I + 1, "F")
        J = J + 1
    Next I
'
End Sub

 

[SEMME]

Ohhh mon Dieu, mais c'est formidable!!!


Great Stuff!!!

I notice I can call for less than 20 numbers if I wish.

Merci Beaucoup PCL
Semme

 

[PCL]

Je t'en prie, you 're wellcome,
I'm allways surprised when it works.

 

[SEMME]

Cher PCL,

I was so excited, but there is one change I would like to make.
In your code two groups of 20 numbers are generated, (nice!) however
the one group of 20 numbers (previous (E1:E20) are static, that is,
the numbers are manually input to cells "E1:E20".

From there, your model is 'a la perfection' where a second group is
generated randomly without duplicates compared with static group E1:E20!

a bientot,
Semme

 

[PCL]

OK, for me initialy only the quantity of numbers for selection was manual.
But let's see how next code fit.
It's long because I kept the same code for each group and put some
cosmetic.
Assuming:
Group1 = A1:A18
Group2 = B1:B18
Group3 = C1:C18
Group4 = D1:D18
Area to fill manually= E1:E20
Area to fill with random numbers = F1: F18
To avoid any confusion exist
Grp1_Select1 where must be entered Group1 numbers ( for me is used L1:L18) with a validation from a list.
The same with Grp2_Select1, Grp3_Select1, Grp4_Select1
Exist still Grp1_Select2, Grp2_Select2, Grp3_Select2, Grp4_Select2 where must be informed the quantity of numbers to prepare for each group.
Exist an working range, Working_Range = A28:B45 where the first column is filled with = Rand()
The first part of the macro is to copy data from Grp2_Select1, Grp3_Select1, Grp4_Select1 to column E you remove it.

Option Explicit
Sub Random_Number2()
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 IPRES
Dim TMP
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
    Set MyRANGE = Range("E1:E20")
'=================     FOR  GROUP  1  =================
'------   PREPARE  RANDOM  AREA  with  GROUP  -------
    J = 1
    With MyRANGE
        Range("Working_Range").Offset(, 1).ClearContents      '----  CLEAN  UP  PREVIOUS  DATA
        For Each F In Range("GRP1_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  GROUPE   -------
    With Range("Working_Range")
        With Range(.Cells(1, 1), .Cells(.Rows.Count - NB_Nb_GRP1, 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 GRP1_Select2
            Cells(K, "F") = .Cells(I, 2)
            K = K + 1
        Next I
    End With
    
'=================     FOR  GROUP  2  =================
'------   PREPARE  RANDOM  AREA  with  GROUP  -------
    J = 1
    With MyRANGE
        Range("Working_Range").Offset(, 1).ClearContents      '----  CLEAN  UP  PREVIOUS  DATA
        For Each F In Range("GRP2_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  GROUPE   -------
    With Range("Working_Range")
        With Range(.Cells(1, 1), .Cells(.Rows.Count - NB_Nb_GRP2, 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 GRP2_Select2
            Cells(K, "F") = .Cells(I, 2)
            K = K + 1
        Next I
    End With
'=================     FOR  GROUP  3  =================
'------   PREPARE  RANDOM  AREA  with  GROUP  -------
    J = 1
    With MyRANGE
        Range("Working_Range").Offset(, 1).ClearContents      '----  CLEAN  UP  PREVIOUS  DATA
        For Each F In Range("GRP3_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  GROUPE   -------
    With Range("Working_Range")
        With Range(.Cells(1, 1), .Cells(.Rows.Count - NB_Nb_GRP3, 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 GRP3_Select2
            Cells(K, "F") = .Cells(I, 2)
            K = K + 1
        Next I
    End With
'=================     FOR  GROUP  4  =================
'------   PREPARE  RANDOM  AREA  with  GROUP  -------
    J = 1
    With MyRANGE
        Range("Working_Range").Offset(, 1).ClearContents      '----  CLEAN  UP  PREVIOUS  DATA
        For Each F In Range("GRP4_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  GROUPE   -------
    With Range("Working_Range")
        With Range(.Cells(1, 1), .Cells(.Rows.Count - NB_Nb_GRP4, 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 GRP4_Select2
            Cells(K, "F") = .Cells(I, 2)
            K = K + 1
        Next I
    End With
End Sub

 

[SEMME]

Bonjour PCL,

Thank's for this...
There is alot going on in your new code and I am not expert enough to follow perfectly.
Could you expand a little more detail on how I should prepare my sheet.

I'm not understanding why E1:E20 and F1:F18 are is introduced here?

I certainly hope I'm not imposing too much on your time.

Merci,
Semme

 

[PCL]

Excuse me there is some mistakes:
You have to read E1: E20 and F1:F20
In the other hand change next code for group3 and 4:

        With Range(.Cells(1, 1), .Cells(.Rows.Count - 1 - NB_Nb_GRP3, 2))   '---  THIS  GROUP  HAS 17 = 18 - 1 value

and

        With Range(.Cells(1, 1), .Cells(.Rows.Count - 1 - NB_Nb_GRP4, 2))       '---  THIS  GROUP  HAS 17 = 18 - 1 value

Some explanations.
Group 1 is from A1 to A18 and is named GRP1_Data
Group 2 is from B1 to B18 and is named GRP2_Data
Group 3 is from C1 to C17 and is named GRP3_Data
Group 4 is from D1 to D17 and is named GRP4_Data
E1:E20 is the bunch of numbers you select manualy from group 1,2,3,4
F1:F20 is the numbers randomly selected from Group 1,2,3,4
A28:B45 is a working range named Working_Range, the first column A28:A45 contains the formula = rand()
L1:L18 is named Grp1_Select1, and is the numbers from group1 you manualy selected e.g: 4 , 6, 7
M1:M18 is named Grp2_Select1, and is the numbers from group2 you manualy selected e.g: 20, 22, 25, 26, 35
N1:N17 is named Grp3_Select1, and is the numbers from group3 you manualy selected e.g: 38, 41, 43
O1:O17 is named Grp4_Select1, and is the numbers from group4 you manualy selected e.g: 54, 56, 57, 58, 58, 59, 60, 64, 65, 66
so we 3 + 5 + 3 + 9 numbers in E1: E20
We need 4 cells named: Grp1_Select2, Grp2_Select2, Grp3_Select2, Grp4_Select2 were we have to inform about the quantity of numbers to pick up randomly in each group e.g: 4, 5, 6, 5
The macro first fill the range E1:E20 with numbers from range Grp1_Select1, Grp2_Select1, Grp3_Select1, Grp4_Select1. I use this way to have a validation list it can be simplify.
For each group the macro prepare the list for remaining numbers and install this list in the working range.
The working range permit to prepare randomly a numbers list from the previous list.
Then we just need to read the N first numbers we need to put in the range F1:F20.
HTH