VBA random numbers generator with required sum

[motilulla]

VBA random numbers generator with required sum </SPAN></SPAN>

I need a VBA that can choose 7 random numbers out of 3 numbers, which are listed in the cells A4:A6 </SPAN></SPAN>

Create for example 50 random in the cells F4:L53 without repetitions (I mean 2 rows should not be the same) as per each row sum is as assigned in the column M, is it possible? (Sum can be vary from 0 to 14)</SPAN></SPAN>

In the example below some set are shown with row sum=7 </SPAN></SPAN>

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

Thank you all</SPAN></SPAN>

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

 

[motilulla]

Or try:

Public Sub MyRandom()
Dim arr(1 To 7)
Dim i As Long
Dim mySum As Long
Randomize
Do While mySum <> 7
mySum = 0
    For i = 1 To 7
        arr(i) = Int(Rnd() * 3)
        mySum = mySum + arr(i)
    Next
Loop
Range("A1:G1") = arr


End Sub

Thank you Phuoc, for your help, yes this code generate with sum 7 but only one line each time I want it generate all as per post#1</SPAN></SPAN>

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

 

[Akuini]

VBA random numbers generator with required sum

I need a VBA that can choose 7 random numbers out of 3 numbers, which are listed in the cells A4:A6

Create for example 50 random in the cells F4:L53 without repetitions (I mean 2 rows should not be the same) as per each row sum is as assigned in the column M, is it possible? (Sum can be vary from 0 to 14)

Regards,
Moti

Ok, try this:
Some part of this code is using Phuoc's code above.

Sub a1079591a()
'https://www.mrexcel.com/forum/excel-questions/1079591-vba-random-numbers-generator-required-sum.html
Dim arr(1 To 7), d As Object
Dim i As Long, j As Long, k As Long
Dim dSum As Long, txt As String
Randomize
n = 1000
Set d = CreateObject("scripting.dictionary")
ReDim va(1 To n, 1 To 7)
Do
    dSum = 0
    For i = 1 To 7
        arr(i) = Int(Rnd() * 3)
        dSum = dSum + arr(i)
    Next
    If dSum = 7 Then
    txt = ""
        For i = 1 To 7
            txt = txt & arr(i)
        Next
        
        If Not d.Exists(txt) Then
            d(txt) = ""
            j = j + 1
                For i = 1 To 7
                    va(j, i) = arr(i)
                Next
        End If
    End If
    k = k + 1
Loop Until j = n Or k > 100000
Range("A1").Resize(UBound(va, 1), 7) = va

End Sub

 

[Akuini]

I edited the above code.
I added this line:
txt = ""

 

[rlv01]

VBA random numbers generator with required sum

I need a VBA that can choose 7 random numbers out of 3 numbers, which are listed in the cells A4:A6 ... is it possible? (Sum can be vary from 0 to 14)

Adding a requirement that the sum of each row must be the same as all the other rows changes the nature of the exercise. You are no longer asking to randomly generate a seven number set, since a set of numbers cannot be random if you constrain the sum of those numbers. Rather it becomes an execise of determing unique combinations of 7 numbers using a 3 number set, that all have the same sum. Using any sort of random number generation will hinder that, since the only way to use randomly generated numbers to produce a desired sum is to iterate and hope for the best. The modifed code below will do that for small table sizes, but if you increase the number of rows, then the number of iterations required will quickly become large.

Sub DoSomething()
    Dim WS As Worksheet
    Dim RangeOfCells As Range, RR As Range, RC As Range
    Dim I As Long, RSum As Long
    Dim S As String
    Dim SD As Object
    Dim DoNextRow As Boolean

    Set WS = ActiveSheet
    Set SD = CreateObject("Scripting.dictionary")
    Set RangeOfCells = WS.Range("F4:L53")             'Your example range

    Application.ScreenUpdating = False
    For Each RR In Intersect(RangeOfCells.Columns(1), RangeOfCells)
        I = 0
        S = ""
        Do
            RSum = 0
            For Each RC In Intersect(RR.EntireRow, RangeOfCells)
                RC.Value = Application.WorksheetFunction.RandBetween(0, 2)
                RSum = RSum + RC.Value
                S = S & RC.Value
            Next RC

            DoNextRow = (RSum = 7) And Not SD.exists(S)
            If DoNextRow Then
                SD.Add S, 0                           'Unique row
            End If
            I = I + 1
            S = ""
        Loop Until DoNextRow Or I > 5000              'I > 5000 is to prevent a runaway loop.
    Next RR
    Set SD = Nothing
    Application.ScreenUpdating = True
End Sub

 

[strooman]

I took the challenge to come up with something but it's far from bullet proof. I'm stuck at comparing the results so that there are no duplicates. Perhaps someone can tackle that

Prints the result to the immediate window of the visual basic editor.

Sub RandomNumbers()
Dim lngLower, lngUpper, x, r, c As Long
Dim MyArray(0 To 6) As Long

lngLower = 0
lngUpper = 2

For x = 1 To 53
    Do While WorksheetFunction.Sum(MyArray) <> 7
        For r = 0 To 6
            MyArray(r) = Evaluate("RandBetween(" & lngLower & "," & lngUpper & ")")
        Next r
    Loop
    
    For c = 0 To 6
        Debug.Print MyArray(c);
    Next c
    
    Debug.Print "= " & WorksheetFunction.Sum(MyArray)
    
    Erase MyArray
Next x
End Sub

 

[motilulla]

Ok, try this:
Some part of this code is using Phuoc's code above.

Sub a1079591a()
'https://www.mrexcel.com/forum/excel-questions/1079591-vba-random-numbers-generator-required-sum.html
Dim arr(1 To 7), d As Object
Dim i As Long, j As Long, k As Long
Dim dSum As Long, txt As String
Randomize
n = 1000
Set d = CreateObject("scripting.dictionary")
ReDim va(1 To n, 1 To 7)
Do
    dSum = 0
    For i = 1 To 7
        arr(i) = Int(Rnd() * 3)
        dSum = dSum + arr(i)
    Next
    If dSum = 7 Then
    txt = ""
        For i = 1 To 7
            txt = txt & arr(i)
        Next
        
        If Not d.Exists(txt) Then
            d(txt) = ""
            j = j + 1
                For i = 1 To 7
                    va(j, i) = arr(i)
                Next
        End If
    End If
    k = k + 1
Loop Until j = n Or k > 100000
Range("A1").Resize(UBound(va, 1), 7) = va

End Sub

Thank you Akuini, tried you code it generate with sum 7 all possible unique combinations total 393, (and changing the value in this line-->"If dSum = 7 Then " 0 to 14" also it gives me all unique possible sets with each sum that I find it is very useful.</SPAN></SPAN>

Coming to my query, which is not quite clear in the opening post#1, lets re take it...</SPAN></SPAN>
1- I wanted that code generate only the unique set as long as specific sum value finds in the column M</SPAN></SPAN>
2- of course if code generate with 7 values as per column M then if I will replace 6, 5, 4, 3 or any between (0 to 14) it will make all the row with the specific assigned sum</SPAN></SPAN>
It is my fault did not explain very well I am sorry about that.</SPAN></SPAN>

Here I will try to explain again what I wanted might this help... example below shows in the column M4:M53 there are different sum vales in order 0 to 14, I want to generate each row combination as per sum M column--> row 4 sum = 0, row 5&6 sum = 1, 7&8 sum = 3 and so on...for next row, </SPAN></SPAN>
And generate all rows as long as sum find in the M Column </SPAN></SPAN>

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

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

 

[motilulla]

Adding a requirement that the sum of each row must be the same as all the other rows changes the nature of the exercise. You are no longer asking to randomly generate a seven number set, since a set of numbers cannot be random if you constrain the sum of those numbers. Rather it becomes an execise of determing unique combinations of 7 numbers using a 3 number set, that all have the same sum. Using any sort of random number generation will hinder that, since the only way to use randomly generated numbers to produce a desired sum is to iterate and hope for the best. The modifed code below will do that for small table sizes, but if you increase the number of rows, then the number of iterations required will quickly become large.

Sub DoSomething()
    Dim WS As Worksheet
    Dim RangeOfCells As Range, RR As Range, RC As Range
    Dim I As Long, RSum As Long
    Dim S As String
    Dim SD As Object
    Dim DoNextRow As Boolean

    Set WS = ActiveSheet
    Set SD = CreateObject("Scripting.dictionary")
    Set RangeOfCells = WS.Range("F4:L53")             'Your example range

    Application.ScreenUpdating = False
    For Each RR In Intersect(RangeOfCells.Columns(1), RangeOfCells)
        I = 0
        S = ""
        Do
            RSum = 0
            For Each RC In Intersect(RR.EntireRow, RangeOfCells)
                RC.Value = Application.WorksheetFunction.RandBetween(0, 2)
                RSum = RSum + RC.Value
                S = S & RC.Value
            Next RC

            DoNextRow = (RSum = 7) And Not SD.exists(S)
            If DoNextRow Then
                SD.Add S, 0                           'Unique row
            End If
            I = I + 1
            S = ""
        Loop Until DoNextRow Or I > 5000              'I > 5000 is to prevent a runaway loop.
    Next RR
    Set SD = Nothing
    Application.ScreenUpdating = True
End Sub

Thank you rlv01, for your help yes it is generate 50 combinations as I asked in the post#1, but now i want as per post#16 is it possible?</SPAN></SPAN>

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

 

[motilulla]

I took the challenge to come up with something but it's far from bullet proof. I'm stuck at comparing the results so that there are no duplicates. Perhaps someone can tackle that

Prints the result to the immediate window of the visual basic editor.

Sub RandomNumbers()
End Sub

strooman, thank you for looking in to it. </SPAN></SPAN>

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

 

[Akuini]

Here I will try to explain again what I wanted might this help... example below shows in the column M4:M53 there are different sum vales in order 0 to 14, I want to generate each row combination as per sum M column--> row 4 sum = 0, row 5&6 sum = 1, 7&8 sum = 3 and so on...for next row,
And generate all rows as long as sum find in the M Column

Regards,
Moti

I want to be clear, using your example in post #16 :
Do you mean the rows in col F:L are actually blank? then you want the macro to fill the rows with combination (0,1,2) which total sum is in col M?

 

[motilulla]

I want to be clear, using your example in post#16 :

Do you mean the rows in col F:L are actually blank?

Yes Akuini, you are correct all col F:L rows are blank.

then you want the macro to fill the rows with combination (0,1,2) which total sum is in col M?

Yes Akuini, you got it my viewpoint it is perfect as you describe.</SPAN></SPAN>

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

</SPAN>