Fill random 3 columns.

[motilulla]

Using Excel 2010

Hello, I want to be filled random 1’s, X’s & 2’s as per selected amount in the columns C, D & E…for example column C in the range C6:C19 there are 14 cells…

Step-1 fills 5 times 1’s as per specified quantity 5 in C5…in the range C6:C19
Step-2 fills 5 times X’s as per specified quantity 5 in D5… in the range D6:D19 But within empty row which are not filled by 1’s…
Step-3 fills 4 times 2’s as per specified quantity 4 in E5… in the range E6:E19 But within empty row which are not filled by 1’s & X’s…

Note: Number for the could be vary in the 1’s, X’s & 2’s could be vary in the range C5:E5…Please suggest VBA solution

Shuffle.xlsm
	A	B	C	D	E	F
1
2
3			Random	Random	Random
4			1	X	2
5		nº	5	5	4
6		1	1
7		2		X
8		3			2
9		4	1
10		5		X
11		6			2
12		7		X
13		8	1
14		9		X
15		10			2
16		11	1
17		12		X
18		13	1
19		14			2
20
21
22
23
24
25
26
Sheet1

Regards,
Moti

 

[Phuoc]

Try this:

Public Sub Random3()
Dim i&, k&, sum3&
Dim sArr, rArr
sArr = Range("C4:E5").Value
sum3c = sArr(2, 1) + sArr(2, 2) + sArr(2, 3)
ReDim rArr(1 To sum3c, 1 To 3)

For i = 1 To sum3c
    Do
        k = Application.RandBetween(1, 3)
    Loop While sArr(2, k) = 0
        sArr(2, k) = sArr(2, k) - 1
        rArr(i, k) = sArr(1, k)
Next i
Range("C6").Resize(sum3c, 3).Value = rArr
End Sub

 

[motilulla]

Phuoc, thank you very much this is a perfect solution what I wanted.

One additional request if it is viable for example if I Pre-select number of 1’s, x’s & 2 in the column C in the range C6:C19 does it is possible to shuffle them in the same column or get shuffle result in the column D as shown. Please could you take a look?

Shuffle.xlsm
	A	B	C	D	E
1
2
3
4			Pre Selected	Shaffle
5		nº	1X2	HERE
6		1	1	X
7		2	1	1
8		3	1	2
9		4	1	X
10		5	1	1
11		6	1	2
12		7	X	1
13		8	X	X
14		9	X	2
15		10	2	2
16		11	2	2
17		12	2	1
18		13	2	1
19		14	2	1
20
21
22
Sheet2

Have a blessed week ahead.

Kind Regards,
Moti

 

[motilulla]

Phuoc, thank you very much this is a perfect solution what I wanted.

One additional request if it is viable for example if I Pre-select number of 1’s, x’s & 2 in the column C in the range C6:C19 does it is possible to shuffle them in the same column or get shuffle result in the column D as shown. Please could you take a look?

Shuffle.xlsm
	A	B	C	D	E
1
2
3
4			Pre Selected	Shaffle
5		nº	1X2	HERE
6		1	1	X
7		2	1	1
8		3	1	2
9		4	1	X
10		5	1	1
11		6	1	2
12		7	X	1
13		8	X	X
14		9	X	2
15		10	2	2
16		11	2	2
17		12	2	1
18		13	2	1
19		14	2	1
20
21
22
Sheet2

Have a blessed week ahead.

Kind Regards,
Moti

Hello, I found “VBA Shuffle Cells… in MrExcel” may it can be useful for someone. Have a nice day.Good Luck

Kind Regards,
Moti

'https://www.mrexcel.com/board/threads/shuffle-cells.367226/#post-1820408
'Shuffle Cells

Sub Shuffle_Columns_Cells() 'By jindon
Dim a(), i As Long
a = Range("C6", Range("C" & Rows.Count).End(xlUp)).Resize(, 2).Value
Randomize
For i = 1 To UBound(a, 1)
    a(i, 2) = Rnd
Next
VSortMA a, 1, UBound(a, 1), 2
Range("D6").Resize(UBound(a, 1)).Value = a
End Sub
 
Private Sub VSortMA(ary, LB, UB, ref)
Dim M As Variant, i As Long, ii As Long, iii As Long
i = UB: ii = LB
M = ary(Int((LB + UB) / 2), ref)
Do While ii <= i
     Do While ary(ii, ref) < M
          ii = ii + 1
     Loop
     Do While ary(i, ref) > M
          i = i - 1
     Loop
     If ii <= i Then
          For iii = LBound(ary, 2) To UBound(ary, 2)
               temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
          Next
          ii = ii + 1: i = i - 1
     End If
Loop
If LB < i Then VSortMA ary, LB, i, ref
If ii < UB Then VSortMA ary, ii, UB, ref
End Sub

 

[Phuoc]

Or use this code:

Sub Random2()

Dim arr, i As Long, u As Long, k As Long, temp As String
arr = Range("a1", Range("a" & Rows.Count).End(xlUp)).Value
Randomize
u = UBound(arr, 1)
For i = 1 To u
    k = Int(Rnd() * u) + 1
    temp = arr(i, 1)
    arr(i, 1) = arr(k, 1)
    arr(k, 1) = temp
Next

Range("B2").Resize(u).Value = arr

End Sub

 

[motilulla]

Or use this code:

Phuoc, that’s better thank you for our kind help.

Have a nice day. Good Luck

Kind Regards,
Moti