VBA Generate random 10 Group of 5 numbers

[motilulla]

Hello,

Looking VBA solution which generate random 10 group of 5 numbers using all 50 numbers in cells D2:H11
List of numbers is in cells A2:A51.
If all numbers are used in to cross check C1 will show sum of 50 numbers = 1275
Example…

Book1
	A	B	C	D	E	F	G	H
1	Numbers		1275	n1	n2	n3	n4	n5
2	1		Group1	34	41	9	20	23
3	2		Group2	21	15	50	5	7
4	3		Group3	19	11	18	30	8
5	4		Group4	32	13	48	12	31
6	5		Group5	1	43	46	39	38
7	6		Group6	36	49	16	26	33
8	7		Group7	10	44	35	27	37
9	8		Group8	25	17	3	45	24
10	9		Group9	40	42	2	14	29
11	10		Group10	4	28	22	47	6
12	11
13	12
14	13
15	14
16	15
17	16
18	17
19	18
20	19
21	20
22	21
23	22
24	23
25	24
26	25
27	26
28	27
29	28
30	29
31	30
32	31
33	32
34	33
35	34
36	35
37	36
38	37
39	38
40	39
41	40
42	41
43	42
44	43
45	44
46	45
47	46
48	47
49	48
50	49
51	50
Random-50

Cell Formulas
Range	Formula
C1	=SUM(D2:H11)

Thanks In Advance
Using version 2000

Regards,
Moti

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26Jun47
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, nRay() [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] nRdn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
Ac = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 Ray = Application.Transpose(Rng)
  ReDim nRay(1 To 10, 1 To 5)
                Randomize
    [COLOR="Navy"]Do[/COLOR] Until c * Ac = 50
        nRdn = Int(Rnd * Rng.Count) + 1
        [COLOR="Navy"]If[/COLOR] Not Ray(nRdn) = vbNullString [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] c = 10 [COLOR="Navy"]Then[/COLOR]
                c = 0: Ac = Ac + 1
            [COLOR="Navy"]End[/COLOR] If
            c = c + 1
            nRay(c, Ac) = Ray(nRdn)
            Ray(nRdn) = vbNullString
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Loop[/COLOR]
Range("D2").Resize(10, 5) = nRay
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[motilulla]

Try this:-

[COLOR=navy]Sub[/COLOR] MG26Jun47
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Ray [COLOR=navy]As[/COLOR] Variant, nRay() [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] nRdn [COLOR=navy]As[/COLOR] [COLOR=navy]Integer,[/COLOR] Ac [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
Ac = 1
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 Ray = Application.Transpose(Rng)
  ReDim nRay(1 To 10, 1 To 5)
                Randomize
    [COLOR=navy]Do[/COLOR] Until c * Ac = 50
        nRdn = Int(Rnd * Rng.Count) + 1
        [COLOR=navy]If[/COLOR] Not Ray(nRdn) = vbNullString [COLOR=navy]Then[/COLOR]
            [COLOR=navy]If[/COLOR] c = 10 [COLOR=navy]Then[/COLOR]
                c = 0: Ac = Ac + 1
            [COLOR=navy]End[/COLOR] If
            c = c + 1
            nRay(c, Ac) = Ray(nRdn)
            Ray(nRdn) = vbNullString
        [COLOR=navy]End[/COLOR] If
    [COLOR=navy]Loop[/COLOR]
Range("D2").Resize(10, 5) = nRay
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

MickG, VBA results as appeal. Thank You!!

May I ask you if it is not much trouble for you, Please can you make it arrange the rows in ascending order?

Regards,
Moti

 

[MickG]

How would that look ???
Perhaps sort each column or each row ?????
Example please !!

 

[motilulla]

How would that look ???
Perhaps sort each column or each row ?????
Example please !!

Mick, Results rows in ascending order

For example this…

Book1
	C	D	E	F	G	H
1	1275	n1	n2	n3	n4	n5
2	Group1	6	42	47	18	40
3	Group2	28	21	44	5	15
4	Group3	10	39	45	12	30
5	Group4	4	32	11	8	3
6	Group5	1	19	26	2	49
7	Group6	35	25	16	24	29
8	Group7	31	27	7	48	22
9	Group8	33	38	37	34	43
10	Group9	50	41	46	17	20
11	Group10	36	13	23	14	9
Random-50

To this…

Book1
	C	D	E	F	G	H
1	1275	n1	n2	n3	n4	n5
2	Group1	6	18	40	42	47
3	Group2	5	15	21	28	44
4	Group3	10	12	30	39	45
5	Group4	3	4	8	11	32
6	Group5	1	2	19	26	49
7	Group6	16	24	25	29	35
8	Group7	7	22	27	31	48
9	Group8	33	34	37	38	43
10	Group9	17	20	41	46	50
11	Group10	9	13	14	23	36
Random-50-1

Thank you

Regards,
Moti

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG26Jun42
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, nRay() [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] nRdn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
Ac = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 Ray = Application.Transpose(Rng)
  ReDim nRay(1 To 10, 1 To 5)
                Randomize
    [COLOR="Navy"]Do[/COLOR] Until c * Ac = 50
        nRdn = Int(Rnd * Rng.Count) + 1
        [COLOR="Navy"]If[/COLOR] Not Ray(nRdn) = vbNullString [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] c = 10 [COLOR="Navy"]Then[/COLOR]
                c = 0: Ac = Ac + 1
            [COLOR="Navy"]End[/COLOR] If
            c = c + 1
            nRay(c, Ac) = Ray(nRdn)
            Ray(nRdn) = vbNullString
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Loop[/COLOR]
Range("D2").Resize(10, 5) = nRay
[COLOR="Navy"]Set[/COLOR] Rng = Range("D2:D11")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Dn.Resize(, 5), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    [COLOR="Navy"]With[/COLOR] ActiveSheet.Sort
        .SetRange Dn.Resize(, 5)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[motilulla]

Try this:-
Regards Mick

Hello MickG,

I tried lot to get fix highlighting following line.

 ActiveSheet.Sort.SortFields.Clear

No luck, need your help again please can you fix it?

Thank you

Regards,
Moti

 

[MickG]

I'm not sure what your problem is !!
Compare your problem with this example of Your sheet.
https://app.box.com/s/8e4uszm3hve4n1w7708flgy8fo6j0w30

 

[motilulla]

I'm not sure what your problem is !!
Compare your problem with this example of Your sheet.

Mick, I realized it is my older version problem, which limits many functions this does not work, needs to change latest one....

Post #3 is code working like a charm!! It is perfect

I appreciate you time and help!!

Regards,
Moti

 

[MickG]

Try this with different sort code.

[COLOR="Navy"]Sub[/COLOR] MG26Jun00
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, R [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, nRay() [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] nRdn [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
Ac = 1
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 Ray = Application.Transpose(Rng)
  ReDim nRay(1 To 10, 1 To 5)
                Randomize
    [COLOR="Navy"]Do[/COLOR] Until c * Ac = 50
        nRdn = Int(Rnd * Rng.Count) + 1
        [COLOR="Navy"]If[/COLOR] Not Ray(nRdn) = vbNullString [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] c = 10 [COLOR="Navy"]Then[/COLOR]
                c = 0: Ac = Ac + 1
            [COLOR="Navy"]End[/COLOR] If
            c = c + 1
            nRay(c, Ac) = Ray(nRdn)
            Ray(nRdn) = vbNullString
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Loop[/COLOR]
Range("D2").Resize(10, 5) = nRay
[COLOR="Navy"]Set[/COLOR] Rng = Range("D2:D11")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
  R = Dn.Resize(, 5).Value
    [COLOR="Navy"]For[/COLOR] Ac = 1 To 5
        Dn(, Ac) = Application.Small(R, Ac)
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick