Generate 7 random out of 9 number limiting max repeated 2 or 3

[motilulla]

Hello,</SPAN>

Here is a bit difficult random number generator task, because I need a VBA that can choose 7 random numbers out of 9, which are listed in the cells A4:A12 </SPAN></SPAN>

Create for example 52 random in the cells F4:L55 but conditions is limit max repetitions 2 or 3 as shown in the example below is it possible?</SPAN></SPAN>

Finally in the column N list the repeated numbers amount</SPAN></SPAN>

Example...

Book1
	A	B	C	D	E	F	G	H	I	J	K	L	M	N
1
2
3	Total Numbers					n1	n2	n3	n4	n5	n6	n7		Max Repeated
4	1					3	1	5	5	7	1	3		2
5	2					8	5	8	1	5	6	1		2
6	3					3	1	5	5	7	1	3		2
7	4					5	2	5	3	4	5	1		3
8	5					2	2	1	5	2	8	1		3
9	6					6	8	7	1	5	1	4		2
10	7					3	4	1	4	1	3	3		3
11	8					2	6	2	1	4	1	3		2
12	9					1	4	8	3	8	2	8		3
13						2	3	1	1	3	4	3		3
14						3	6	4	8	3	1	8		2
15						1	3	5	3	1	5	3		3
16						3	2	3	1	4	1	8		2
17						1	1	5	8	4	3	6		2
18						1	4	5	2	4	1	3		2
19						5	3	2	1	4	1	4		2
20						1	1	4	1	5	8	3		3
21						3	4	1	5	2	1	2		2
22						1	9	9	2	9	5	6		3
23						4	9	9	9	2	2	3		3
24						1	4	4	8	8	2	2		2
25						1	4	5	3	3	5	6		2
26						1	2	1	2	1	3	4		3
27						2	1	5	2	8	2	5		3
28						9	1	3	6	4	5	3		2
29						2	4	1	1	1	3	3		3
30						5	1	7	2	3	2	3		2
31						2	6	1	7	1	3	7		2
32						3	1	1	1	4	8	8		3
33						6	1	8	1	4	3	1		3
34						3	5	5	8	8	3	4		2
35						1	2	3	7	4	2	3		2
36						8	3	2	1	1	8	1		3
37						7	5	3	3	2	4	5		2
38						8	4	3	5	1	1	5		2
39						8	2	1	1	3	5	2		2
40						4	2	5	5	1	1	1		3
41						3	3	5	5	6	8	5		3
42						3	3	2	7	2	9	1		2
43						3	4	7	1	1	2	6		2
44						5	6	2	8	2	3	7		2
45						9	1	3	6	9	1	9		3
46						2	7	4	4	8	1	7		2
47						6	3	1	1	4	2	8		2
48						5	3	1	5	2	8	2		2
49						3	9	3	2	1	1	1		3
50						5	1	9	1	9	8	4		2
51						2	5	3	4	2	9	2		3
52						2	2	1	8	1	2	1		3
53						3	1	3	4	1	5	8		2
54						1	4	3	3	2	2	3		3
55						2	1	4	3	8	6	2		2
Sheet10

</SPAN></SPAN>

Thank you all</SPAN></SPAN>

Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>

 

[Rick Rothstein]

Thank you Rick, code worked fine!! it is generating lines with max 1 also, can be restricted Min repeated to 2, and Max repeated to 3</SPAN></SPAN>

Regards,</SPAN></SPAN>
Moti </SPAN></SPAN>

I believe this modification of the code I posted earlier will do that...

[table="width: 500"]
[tr]
	[td]Sub RandomNumbersLimited()
  Dim R As Long, C As Long, MaxRepts As Long, HowMany As Long, Rand As Long
  Dim Nums As Variant, Result As Variant, Maxes As Variant, Used As Variant
  Randomize
  MaxRepts = 3
  HowMany = 52
  ReDim Result(1 To HowMany, 1 To 7)
  Nums = Range("A4", Cells(Rows.Count, "A").End(xlUp))
  ReDim Maxes(1 To HowMany, 1 To 1)
  For R = 1 To HowMany
    Do
      ReDim Used(1 To UBound(Nums))
      For C = 1 To 7
        Do
          Rand = Int((Nums(UBound(Nums), 1) - Nums(1, 1) + 1) * Rnd + Nums(1, 1))
          If Used(Rand) < MaxRepts Then
            Used(Rand) = Used(Rand) + 1
            Result(R, C) = Rand
            Exit Do
          End If
        Loop
      Next
      Maxes(R, 1) = Application.Max(Used)
    Loop While Maxes(R, 1) = 1
  Next
  Range("F4:L4").Resize(UBound(Result)) = Result
  Range("N4").Resize(UBound(Maxes)) = Maxes
End Sub[/td]
[/tr]
[/table]

Changed this line
Num = Application.Randbetween(1, 9) 
 
This one 
Num = Int(Rnd * 9) + 1

Given the change you made to Mick's code, you will need to add a Randomize statement to his code or else you will get repeated results each time you start a new session with the workbook containing his macro.

 

[motilulla]

I believe this modification of the code I posted earlier will do that...

Sub RandomNumbersLimited()
  Dim R As Long, C As Long, MaxRepts As Long, HowMany As Long, Rand As Long
  Dim Nums As Variant, Result As Variant, Maxes As Variant, Used As Variant
  Randomize
  MaxRepts = 3
  HowMany = 52
  ReDim Result(1 To HowMany, 1 To 7)
  Nums = Range("A4", Cells(Rows.Count, "A").End(xlUp))
  ReDim Maxes(1 To HowMany, 1 To 1)
  For R = 1 To HowMany
    Do
      ReDim Used(1 To UBound(Nums))
      For C = 1 To 7
        Do
          Rand = Int((Nums(UBound(Nums), 1) - Nums(1, 1) + 1) * Rnd + Nums(1, 1))
          If Used(Rand) < MaxRepts Then
            Used(Rand) = Used(Rand) + 1
            Result(R, C) = Rand
            Exit Do
          End If
        Loop
      Next
      Maxes(R, 1) = Application.Max(Used)
    Loop While Maxes(R, 1) = 1
  Next
  Range("F4:L4").Resize(UBound(Result)) = Result
  Range("N4").Resize(UBound(Maxes)) = Maxes
End Sub

Rick, thank you for the quick alteration very appreciated. Yes it is perfect minimum 2 and the maximum 3 are looked

Given the change you made to Mick's code, you will need to add a Randomize statement to his code or else you will get repeated results each time you start a new session with the workbook containing his macro.

As I do not understand how to change Randomize statement, in Mick's code I create a new workbook to run your new code </SPAN></SPAN>

Many thanks for your help and time you spent on it to fix all</SPAN></SPAN>

Regards,</SPAN></SPAN>
Moti </SPAN></SPAN>