Select a random number from a list then remove, rinse, repeat

tezza · Nov 30, 2022

Hi all,

Ok, I'll try to explain what I need.

I have a number list 1 - 90

The numbers are split in 9 groups

I need to randomly pick 5 groups then randomly pick 1 number from each of the groups,
Show the numbers picked
remove the picked numbers from the original list

After the first round of picks the list of numbers reduce by five

With the remaining numbers I need to repeat the process - choose 5 random numbers from 5 random groups and remove from list

Rinse and repeat until there are no numbers left

When all the numbers in a group have been used then that group needs to be eliminated.

Bingo.xlsm

A

B

C

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

AM

AN

AO

AP

AQ

AR

AS

AT

AU

AV

AW

AX

AY

AZ

BA

BB

BC

BD

BE

BF

BG

BH

BI

BJ

BK

BL

BM

BN

BO

BP

BQ

BR

BS

BT

BU

BV

BW

BX

BY

BZ

CA

CB

CC

CD

CE

CF

CG

CH

CI

CJ

CK

CL

CM

CN

CO

CP

CQ

CR

1

Random No:

Group

2

1

2

3

4

5

1

2

3

4

5

6

7

8

9

3

11

34

40

68

71

1

2

3

4

5

6

7

9

10

12

13

14

15

16

17

18

19

20

22

23

24

25

26

27

28

29

30

31

32

33

35

36

37

38

41

42

43

44

46

47

49

50

51

52

53

54

56

58

59

60

61

63

64

65

66

67

69

70

72

73

74

75

76

77

78

79

81

82

83

84

86

87

88

89

90

4

8

21

48

55

80

1

2

3

4

5

6

7

9

10

12

13

14

15

16

17

18

19

20

22

23

24

25

26

27

28

29

30

31

32

33

35

36

37

38

41

42

43

44

46

47

49

50

51

52

53

54

56

58

59

60

61

63

64

65

66

67

69

70

72

73

74

75

76

77

78

79

81

82

83

84

86

87

88

89

90

5

39

45

57

62

85

1

2

3

4

5

6

7

9

10

12

13

14

15

16

17

18

19

20

22

23

24

25

26

27

28

29

30

31

32

33

35

36

37

38

41

42

43

44

46

47

49

50

51

52

53

54

56

58

59

60

61

63

64

65

66

67

69

70

72

73

74

75

76

77

78

79

81

82

83

84

86

87

88

89

90

Sheet1

Peter_SSs · Dec 1, 2022

I don't understand your last example at all. Why do some rows in the right grid only have 3 or 4 numbers? I thought 5 were to be chosen each time?

tezza · Dec 1, 2022

Because it's showing ALMOST complete, there's 5 numbers left to pick in the left grid so 2 will go in the 3 count and 1 each in the 4 count to complete the 5 count all the way down.

It was just my way to show and example of what should be left with one final pick to go.

Didn't mean to confuse you.

tezza · Dec 1, 2022

Here's the complete list:

Legacy 143009 · Dec 1, 2022

Working code for the first example:

VBA Code:

Dim ranColumns(4) As Integer
Sub test()
  Dim ranGroups(4) As Integer
  Dim ranGroup As Integer, rand As Integer, i As Integer
  Dim inGroup As Boolean

  rand = 0
  Do While rand <= 4
    inGroup = False
    ranGroup = Int((9 - 1 + 1) * Rnd + 1)
    For Each rndGroup In ranGroups
      If rndGroup = ranGroup Then
        inGroup = True
      End If
    Next
    If Not inGroup Then
      ranGroups(rand) = ranGroup
      rand = rand + 1
    End If
  Loop
  For i = LBound(ranGroups) To UBound(ranGroups)
    For j = i + 1 To UBound(ranGroups)
      If ranGroups(i) > ranGroups(j) Then
        ranGroup = ranGroups(j)
        ranGroups(j) = ranGroups(i)
        ranGroups(i) = ranGroup
      End If
    Next j
  Next i
  For r = 3 To 5 'Number of rows you want to write
  i = 0
    For Each rndGroup In ranGroups
      Select Case rndGroup
        Case 1
          Call pickRandNumber(7, 15, i)
        Case 9
          Call pickRandNumber(86, 96, i)
        Case Else
          Call pickRandNumber((rndGroup * 10) - 4, (rndGroup * 10) + 5, i)
      End Select
      i = i + 1
    Next
    For c = 1 To 5
      Cells(r, c).Value = Cells(r, ranColumns(c - 1)).Value
      Range(Cells(3, ranColumns(c - 1)), Cells(5, ranColumns(c - 1))).ClearContents
    Next
  Next
End Sub
Sub pickRandNumber(c1 As Integer, c2 As Integer, i As Integer)
  Dim ranColumn As Integer
  ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Do While Cells(3, ranColumn).Value = ""
    ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Loop
  ranColumns(i) = ranColumn
End Sub

tezza · Dec 1, 2022

Flashbond said:

Working code for the first example:

VBA Code:

Dim ranColumns(4) As Integer
Sub test()
  Dim ranGroups(4) As Integer
  Dim ranGroup As Integer, rand As Integer, i As Integer
  Dim inGroup As Boolean

  rand = 0
  Do While rand <= 4
    inGroup = False
    ranGroup = Int((9 - 1 + 1) * Rnd + 1)
    For Each rndGroup In ranGroups
      If rndGroup = ranGroup Then
        inGroup = True
      End If
    Next
    If Not inGroup Then
      ranGroups(rand) = ranGroup
      rand = rand + 1
    End If
  Loop
  For i = LBound(ranGroups) To UBound(ranGroups)
    For j = i + 1 To UBound(ranGroups)
      If ranGroups(i) > ranGroups(j) Then
        ranGroup = ranGroups(j)
        ranGroups(j) = ranGroups(i)
        ranGroups(i) = ranGroup
      End If
    Next j
  Next i
  For r = 3 To 5 'Number of rows you want to write
  i = 0
    For Each rndGroup In ranGroups
      Select Case rndGroup
        Case 1
          Call pickRandNumber(7, 15, i)
        Case 9
          Call pickRandNumber(86, 96, i)
        Case Else
          Call pickRandNumber((rndGroup * 10) - 4, (rndGroup * 10) + 5, i)
      End Select
      i = i + 1
    Next
    For c = 1 To 5
      Cells(r, c).Value = Cells(r, ranColumns(c - 1)).Value
      Range(Cells(3, ranColumns(c - 1)), Cells(5, ranColumns(c - 1))).ClearContents
    Next
  Next
End Sub
Sub pickRandNumber(c1 As Integer, c2 As Integer, i As Integer)
  Dim ranColumn As Integer
  ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Do While Cells(3, ranColumn).Value = ""
    ranColumn = Int((c2 - c1 + 1) * Rnd + c1)
  Loop
  ranColumns(i) = ranColumn
End Sub

Hi

Do I insert this into a module or into the sheet?

I've placed it in module and it's just got the timer symbol going after 5 mins. Any ideas?

Peter_SSs · Dec 1, 2022

Flashbond said:
Working code for the first example:

Is it? How long did it take to run? After several minutes I gave up waiting. Looks like tezza had the same problem. Likely related to the issue outlined below.

tezza said:
Here's the complete list:

I'm not convinced that you chose the groups and/or numbers for each group at random.

Here is an example that I did
Starting with all 90 numbers in row 14
- In row 15 I used a random number generator to look to see which groups still had numbers (all 9 groups of course). The groups chosen were 2,8,4,1,7 as shown in cell E15. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in cell F15. I removed those numbers in the range G15:CR15
- In row 16 I used a random number generator to look to see which groups still had numbers (all 9 groups still at this stage). The groups chosen are shown in E16. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in F16. I removed those numbers in the range G16:CR16
- The above process was continued with random groups chosen shown in column E and random available numbers from those groups shown in column F. The chosen numbers removed in cols G:CR

Because random numbers do not necessarily spread themselves exactly evenly (eg tossing a coin 6 times does not necessarily result in 3 heads and 3 tails) you can see in this case that after 15 turns 5 groups have been exhausted of their numbers meaning that my random number generator trying to choose 5 groups with remaining numbers could not do that.

tezza.xlsm

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

AE

AF

AG

AH

AI

AJ

AK

AL

AM

AN

AO

AP

AQ

AR

AS

AT

AU

AV

AW

AX

AY

AZ

BA

BB

BC

BD

BE

BF

BG

BH

BI

BJ

BK

BL

BM

BN

BO

BP

BQ

BR

BS

BT

BU

BV

BW

BX

BY

BZ

CA

CB

CC

CD

CE

CF

CG

CH

CI

CJ

CK

CL

CM

CN

CO

CP

CQ

CR

12

Group

13

1

2

3

4

5

6

7

8

9

14

Turn

5 random Groups

Rand no. from each group

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

69

70

71

72

73

74

75

76

77

78

79

80

81

82

83

84

85

86

87

88

89

90

15

1

2,8,4,1,7

14,77,34,6,69

1

2

3

4

5

7

8

9

10

11

12

13

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

35

36

37

38

39

40

41

42

43

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

70

71

72

73

74

75

76

78

79

80

81

82

83

84

85

86

87

88

89

90

16

2

9,2,5,4,8

81,11,43,37,72

1

2

3

4

5

7

8

9

10

12

13

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

35

36

38

39

40

41

42

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

62

63

64

65

66

67

68

70

71

73

74

75

76

78

79

80

82

83

84

85

86

87

88

89

90

17

3

1,7,4,9,2

2,62,36,90,18

1

3

4

5

7

8

9

10

12

13

15

16

17

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

35

38

39

40

41

42

44

45

46

47

48

49

50

51

52

53

54

55

56

57

58

59

60

61

63

64

65

66

67

68

70

71

73

74

75

76

78

79

80

82

83

84

85

86

87

88

89

18

4

3,8,4,6,5

25,79,31,57,40

1

3

4

5

7

8

9

10

12

13

15

16

17

19

20

21

22

23

24

26

27

28

29

30

32

33

35

38

39

41

42

44

45

46

47

48

49

50

51

52

53

54

55

56

58

59

60

61

63

64

65

66

67

68

70

71

73

74

75

76

78

80

82

83

84

85

86

87

88

89

19

5

8,1,9,5,4

73,1,86,47,33

3

4

5

7

8

9

10

12

13

15

16

17

19

20

21

22

23

24

26

27

28

29

30

32

35

38

39

41

42

44

45

46

48

49

50

51

52

53

54

55

56

58

59

60

61

63

64

65

66

67

68

70

71

74

75

76

78

80

82

83

84

85

87

88

89

20

6

4,8,9,7,2

38,75,83,60,19

3

4

5

7

8

9

10

12

13

15

16

17

20

21

22

23

24

26

27

28

29

30

32

35

39

41

42

44

45

46

48

49

50

51

52

53

54

55

56

58

59

61

63

64

65

66

67

68

70

71

74

76

78

80

82

84

85

87

88

89

21

7

3,9,4,2,5

21,88,35,13,48

3

4

5

7

8

9

10

12

15

16

17

20

22

23

24

26

27

28

29

30

32

39

41

42

44

45

46

49

50

51

52

53

54

55

56

58

59

61

63

64

65

66

67

68

70

71

74

76

78

80

82

84

85

87

89

22

8

9,7,8,2,4

89,65,70,10,32

3

4

5

7

8

9

12

15

16

17

20

22

23

24

26

27

28

29

30

39

41

42

44

45

46

49

50

51

52

53

54

55

56

58

59

61

63

64

66

67

68

71

74

76

78

80

82

84

85

87

23

9

5,7,2,4,8

45,67,16,39,76

3

4

5

7

8

9

12

15

17

20

22

23

24

26

27

28

29

30

41

42

44

46

49

50

51

52

53

54

55

56

58

59

61

63

64

66

68

71

74

78

80

82

84

85

87

24

10

8,4,9,7,2

78,30,84,64,12

3

4

5

7

8

9

15

17

20

22

23

24

26

27

28

29

41

42

44

46

49

50

51

52

53

54

55

56

58

59

61

63

66

68

71

74

80

82

85

87

25

11

6,9,2,7,1

52,80,17,66,4

3

5

7

8

9

15

20

22

23

24

26

27

28

29

41

42

44

46

49

50

51

53

54

55

56

58

59

61

63

68

71

74

82

85

87

26

12

7,6,3,9,5

63,56,27,85,42

3

5

7

8

9

15

20

22

23

24

26

28

29

41

44

46

49

50

51

53

54

55

58

59

61

68

71

74

82

87

27

13

2,5,7,8,9

15,49,68,74,82

3

5

7

8

9

20

22

23

24

26

28

29

41

44

46

50

51

53

54

55

58

59

61

71

87

28

14

3,8,1,5,9

23,71,5,41,87

3

7

8

9

20

22

24

26

28

29

44

46

50

51

53

54

55

58

59

61

29

15

7,1,5,3,6

61,9,46,26,51

3

7

8

20

22

24

28

29

44

50

53

54

55

58

59

90

Legacy 143009 · Dec 1, 2022

I see your point. Since I have no control in Rnd function I will consider the numbers are spread "evenly".
Also another .Value <> "" statement must be added for each column while picking group numbers since there might be no number left to pick. Which will make the process even longer...

tezza · Dec 1, 2022

Peter_SSs said:
Is it? How long did it take to run? After several minutes I gave up waiting. Looks like tezza had the same problem. Likely related to the issue outlined below.

I'm not convinced that you chose the groups and/or numbers for each group at random.

Here is an example that I did
Starting with all 90 numbers in row 14
- In row 15 I used a random number generator to look to see which groups still had numbers (all 9 groups of course). The groups chosen were 2,8,4,1,7 as shown in cell E15. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in cell F15. I removed those numbers in the range G15:CR15
- In row 16 I used a random number generator to look to see which groups still had numbers (all 9 groups still at this stage). The groups chosen are shown in E16. I then used another random generator to pick an available number from each of those groups. Those numbers are shown in F16. I removed those numbers in the range G16:CR16
- The above process was continued with random groups chosen shown in column E and random available numbers from those groups shown in column F. The chosen numbers removed in cols G:CR

Because random numbers do not necessarily spread themselves exactly evenly (eg tossing a coin 6 times does not necessarily result in 3 heads and 3 tails) you can see in this case that after 15 turns 5 groups have been exhausted of their numbers meaning that my random number generator trying to choose 5 groups with remaining numbers could not do that.

tezza.xlsm
D E F G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI AJ AK AL AM AN AO AP AQ AR AS AT AU AV AW AX AY AZ BA BB BC BD BE BF BG BH BI BJ BK BL BM BN BO BP BQ BR BS BT BU BV BW BX BY BZ CA CB CC CD CE CF CG CH CI CJ CK CL CM CN CO CP CQ CR
12 Group Group Group Group Group Group Group Group Group
13 1 2 3 4 5 6 7 8 9
14 Turn 5 random Groups Rand no. from each group 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
15 1 2,8,4,1,7 14,77,34,6,69 1 2 3 4 5 7 8 9 10 11 12 13 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 70 71 72 73 74 75 76 78 79 80 81 82 83 84 85 86 87 88 89 90
16 2 9,2,5,4,8 81,11,43,37,72 1 2 3 4 5 7 8 9 10 12 13 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 35 36 38 39 40 41 42 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 70 71 73 74 75 76 78 79 80 82 83 84 85 86 87 88 89 90
17 3 1,7,4,9,2 2,62,36,90,18 1 3 4 5 7 8 9 10 12 13 15 16 17 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 35 38 39 40 41 42 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 63 64 65 66 67 68 70 71 73 74 75 76 78 79 80 82 83 84 85 86 87 88 89
18 4 3,8,4,6,5 25,79,31,57,40 1 3 4 5 7 8 9 10 12 13 15 16 17 19 20 21 22 23 24 26 27 28 29 30 32 33 35 38 39 41 42 44 45 46 47 48 49 50 51 52 53 54 55 56 58 59 60 61 63 64 65 66 67 68 70 71 73 74 75 76 78 80 82 83 84 85 86 87 88 89
19 5 8,1,9,5,4 73,1,86,47,33 3 4 5 7 8 9 10 12 13 15 16 17 19 20 21 22 23 24 26 27 28 29 30 32 35 38 39 41 42 44 45 46 48 49 50 51 52 53 54 55 56 58 59 60 61 63 64 65 66 67 68 70 71 74 75 76 78 80 82 83 84 85 87 88 89
20 6 4,8,9,7,2 38,75,83,60,19 3 4 5 7 8 9 10 12 13 15 16 17 20 21 22 23 24 26 27 28 29 30 32 35 39 41 42 44 45 46 48 49 50 51 52 53 54 55 56 58 59 61 63 64 65 66 67 68 70 71 74 76 78 80 82 84 85 87 88 89
21 7 3,9,4,2,5 21,88,35,13,48 3 4 5 7 8 9 10 12 15 16 17 20 22 23 24 26 27 28 29 30 32 39 41 42 44 45 46 49 50 51 52 53 54 55 56 58 59 61 63 64 65 66 67 68 70 71 74 76 78 80 82 84 85 87 89
22 8 9,7,8,2,4 89,65,70,10,32 3 4 5 7 8 9 12 15 16 17 20 22 23 24 26 27 28 29 30 39 41 42 44 45 46 49 50 51 52 53 54 55 56 58 59 61 63 64 66 67 68 71 74 76 78 80 82 84 85 87
23 9 5,7,2,4,8 45,67,16,39,76 3 4 5 7 8 9 12 15 17 20 22 23 24 26 27 28 29 30 41 42 44 46 49 50 51 52 53 54 55 56 58 59 61 63 64 66 68 71 74 78 80 82 84 85 87
24 10 8,4,9,7,2 78,30,84,64,12 3 4 5 7 8 9 15 17 20 22 23 24 26 27 28 29 41 42 44 46 49 50 51 52 53 54 55 56 58 59 61 63 66 68 71 74 80 82 85 87
25 11 6,9,2,7,1 52,80,17,66,4 3 5 7 8 9 15 20 22 23 24 26 27 28 29 41 42 44 46 49 50 51 53 54 55 56 58 59 61 63 68 71 74 82 85 87
26 12 7,6,3,9,5 63,56,27,85,42 3 5 7 8 9 15 20 22 23 24 26 28 29 41 44 46 49 50 51 53 54 55 58 59 61 68 71 74 82 87
27 13 2,5,7,8,9 15,49,68,74,82 3 5 7 8 9 20 22 23 24 26 28 29 41 44 46 50 51 53 54 55 58 59 61 71 87
28 14 3,8,1,5,9 23,71,5,41,87 3 7 8 9 20 22 24 26 28 29 44 46 50 51 53 54 55 58 59 61
29 15 7,1,5,3,6 61,9,46,26,51 3 7 8 20 22 24 28 29 44 50 53 54 55 58 59
90

Hmmmmmmmm

My example was a visual random pick, I just looked for the lowest count then randomly put a number in somewhere. Is that something you could factor in?

You have done what I asked to be fair, so, I'm now open to suggestions.

How did you create the random generators in Cols E & F?

Peter_SSs · Dec 1, 2022

tezza said:
How did you create the random generators in Cols E & F?

There was a fair bit of manual input to give the random number generator the values to choose from so it would be no use to you in trying to automate this process.

tezza said:
so, I'm now open to suggestions.

Suggestions for what? To make the randomness not random?

tezza · Dec 2, 2022

Peter, is everything ok?

Your interactions through this post have been irregularly negative, and almost implying I'm thick or something.

Suggestions for what? To make the randomness not random?

No, to make my original query work, which I thought would have been self evident. If I'd have explained that then I would have sounded condescending.

There was a fair bit of manual input to give the random number generator the values to choose from so it would be no use to you in trying to automate this process.

That probably explains why all the 4's came out one after the other, the actual chances of that is higher than winning the lottery, but don't worry, I get your point - EXACTLY

b. It mostly won't work anyway.

Not to worry, in the background the answer silently came, without any negativity:

VBA Code:

Sub Generate_New_Numbers()
Dim Result(1 To 162) As Variant
Dim Output(1 To 18, 1 To 9) As Variant
Dim AR(1 To 90) As Integer:     fillNums AR
Dim Patterns As Object:         setPatterns Patterns
Dim Six As Object:              setSix Six
Dim Grid As Object:             setGrid Grid
Dim Queue As Object

Shuffle AR
fillQueue Queue, AR
fillArray Result, Queue, Patterns, Six, Grid
fillOutput Result, Output
Range("A1").Resize(UBound(Output, 1), UBound(Output, 2)).Value2 = Output
End Sub

Sub setGrid(ByRef Grid As Object)
Set Grid = CreateObject("System.Collections.ArrayList")
Dim lo As Object, hi As Object, tmp As Object

For i = 0 To 5
    Set tmp = CreateObject("System.Collections.ArrayList")
    Set lo = CreateObject("System.Collections.ArrayList")
    Set hi = CreateObject("System.Collections.ArrayList")
    Select Case i
        Case 0
            lo.Add 2
            lo.Add 2
            lo.Add 1
            hi.Add 3
            hi.Add 3
            hi.Add 3
            hi.Add 5
            hi.Add 5
            hi.Add 4
        Case 1
            lo.Add 2
            lo.Add 1
            lo.Add 0
            hi.Add 5
            hi.Add 4
            hi.Add 3
            hi.Add 4
            hi.Add 3
            hi.Add 5
        Case 2
            lo.Add 0
            lo.Add 1
            lo.Add 2
            hi.Add 3
            hi.Add 5
            hi.Add 3
            hi.Add 4
            hi.Add 5
            hi.Add 4
        Case 3
            lo.Add 2
            lo.Add 2
            lo.Add 0
            hi.Add 4
            hi.Add 3
            hi.Add 4
            hi.Add 5
            hi.Add 3
            hi.Add 3
        Case 4
            lo.Add 1
            lo.Add 1
            lo.Add 2
            hi.Add 3
            hi.Add 3
            hi.Add 4
            hi.Add 5
            hi.Add 5
            hi.Add 5
        Case 5
            lo.Add 0
            lo.Add 2
            lo.Add 2
            hi.Add 4
            hi.Add 4
            hi.Add 5
            hi.Add 3
            hi.Add 3
            hi.Add 3
    End Select
tmp.Add lo
tmp.Add hi
Grid.Add tmp
Next i

End Sub

Sub setSix(ByRef Six As Object)
Set Six = CreateObject("System.Collections.ArrayList")

Six.Add Array(1, 0, 0)
Six.Add Array(0, 1, 0)
Six.Add Array(0, 0, 1)
Six.Add Array(1, 1, 0)
Six.Add Array(0, 1, 1)
Six.Add Array(1, 0, 1)
End Sub

Sub setPatterns(ByRef Patterns As Object)
Set Patterns = CreateObject("System.Collections.ArrayList")

Patterns.Add Array(2, 2, 1, 2, 1, 1)
Patterns.Add Array(1, 2, 2, 1, 2, 2)
Patterns.Add Array(2, 1, 2, 2, 2, 1)
Patterns.Add Array(2, 2, 2, 1, 1, 2)
Patterns.Add Array(2, 1, 1, 2, 2, 2)
Patterns.Add Array(1, 2, 2, 2, 2, 1)
Patterns.Add Array(2, 2, 2, 1, 1, 2)
Patterns.Add Array(2, 1, 1, 2, 2, 2)
Patterns.Add Array(1, 2, 2, 2, 2, 2)

End Sub

Function getRnd(hi As Variant, lo As Variant) As Integer
getRnd = Int(((hi + 1) - lo) * Rnd() + lo)
End Function

Sub fillQueue(ByRef Queue As Object, ByRef AR() As Integer)
Set Queue = CreateObject("System.Collections.Queue")
For i = 1 To UBound(AR)
    Queue.enqueue AR(i)
Next i
End Sub

Sub fillNums(ByRef AR() As Integer)
For i = 1 To 90: AR(i) = i: Next i
End Sub

Sub Shuffle(ByRef AR() As Integer)
Randomize
Dim Group As Integer, swap As Integer, tmp As Integer, gs As Integer

gs = 9

For i = 1 To UBound(AR) - 1
    If i = 10 Then gs = gs + 1
    If i < 10 Then
        Group = Int((i - 1) / gs) * gs
        swap = getRnd(Group + gs, Group + 1)
    ElseIf i < UBound(AR) - 10 Then
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 10)
    Else
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 11)
    End If
   
    tmp = AR(i)
    AR(i) = AR(swap)
    AR(swap) = tmp
Next i
End Sub

Sub fillArray(ByRef Result() As Variant, Queue As Object, Patterns As Object, Six As Object, Grid As Object)
Dim RN As Integer: RN = 0
Dim RP As Integer: RP = 0
Dim Pos As Integer: Pos = 1
Dim tmp As Variant
Dim Pat As Variant

For i = 1 To 9
    tmp = Patterns(i - 1)
    For j = 0 To UBound(tmp)
        If tmp(j) = 1 Then
            RP = getRnd(Grid(j)(0).Count - 1, 0)
            Pat = Six(Grid(j)(0)(RP))
            Grid(j)(0).removeAt RP
        Else
            RP = getRnd(Grid(j)(1).Count - 1, 0)
            Pat = Six(Grid(j)(1)(RP))
            Grid(j)(1).removeAt RP
        End If
        For k = LBound(Pat) To UBound(Pat)
            If Pat(k) = 1 Then
                Result(Pos) = Queue.dequeue()
            Else
                Result(Pos) = vbNullString
            End If
            Pos = Pos + 1
        Next k
    Next j
Next i
End Sub

Sub ShuffleOnesTwos(ByRef Pat As Variant)
Dim Pos As Integer, tmp As Integer

For i = LBound(Pat) To UBound(Pat)
    Pos = getRnd(UBound(Pat), 0)
    tmp = Pat(i)
    Pat(i) = Pat(Pos)
    Pat(Pos) = tmp
Next i
End Sub

Sub fillOutput(ByRef Result() As Variant, ByRef Output As Variant)
Dim Col As Integer: Col = 1
Dim Pos As Integer: Pos = 1
For i = LBound(Result) To UBound(Result)
    Output(Pos, Col) = Result(i)
    Pos = Pos + 1
    If i Mod 18 = 0 Then
        Col = Col + 1
        Pos = 1
    End If
Next i
End Sub

Select a random number from a list then remove, rinse, repeat

tezza

Active Member

Peter_SSs

MrExcel MVP, Moderator

Excel Facts

tezza

Active Member

tezza

Active Member

Legacy 143009

Guest

tezza

Active Member

Peter_SSs

MrExcel MVP, Moderator

Legacy 143009

Guest

tezza

Active Member

Peter_SSs

MrExcel MVP, Moderator

tezza

Active Member

Similar threads

Forum statistics

Share this page

Select a random number from a list then remove, rinse, repeat

Active Member

MrExcel MVP, Moderator

Excel Facts

Active Member

Active Member

Legacy 143009

Guest

Active Member

MrExcel MVP, Moderator

Legacy 143009

Guest

Active Member

MrExcel MVP, Moderator

Active Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock