VBA random numbers generator with required sum

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,371
Office Version
  1. 2010
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
ABCDEFGHIJKLM
1
2
3Total Numbersn1n2n3n4n5n6n7SUM
4021001127
5111112107
6201121207
712002117
811201027
920112017
1002110127
1101111127
1211120117
1302111207
1411220017
1510200227
1610012127
1710121117
1821111017
1912012107
2011021117
2112120107
2201112117
2302011127
2411121107
2500112217
2610210127
2711111207
2812200117
2910112117
3001121117
3112111017
3201120127
3312021107
3411111117
3521110027
3622101017
3711102117
3801112027
3902020217
4011120027
4111110217
4220211107
4310221107
4421020117
4511210207
4622100117
4711210117
4810211027
4911211107
5021201017
5122100027
5212110207
5311101217
Sheet1


Thank you all</SPAN></SPAN>

Excel 2000</SPAN></SPAN>
Regards,</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Last edited:
Sort by date Sort by votes
motilulla said:


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


Yes Akuini, you got it my viewpoint it is perfect as you describe.

Regards,
Moti
Click to expand...


Try this:
Assuming header is at row 4 & data start at row 5:

Code: 
[B][COLOR=Royalblue]Sub[/COLOR][/B] a1079591a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1079591-vba-random-numbers-generator-required-sum.html[/COLOR][/I]
[B][COLOR=Royalblue]Dim[/COLOR][/B] arr([COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]), d [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Object[/COLOR][/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] i [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], j [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], k [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B]
[B][COLOR=Royalblue]Dim[/COLOR][/B] dSum [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]Long[/COLOR][/B], txt [B][COLOR=Royalblue]As[/COLOR][/B] [B][COLOR=Royalblue]String[/COLOR][/B]

rr = Range([COLOR=brown]"M"[/COLOR] & Rows.count).[B][COLOR=Royalblue]End[/COLOR][/B](xlUp).Row + [COLOR=crimson]1[/COLOR]
va = Range([COLOR=brown]"M5:M"[/COLOR] & rr)
[B][COLOR=Royalblue]ReDim[/COLOR][/B] vb([COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] UBound(va, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR])

[B][COLOR=Royalblue]For[/COLOR][/B] s = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] UBound(va, [COLOR=crimson]1[/COLOR]) - [COLOR=crimson]1[/COLOR]
    
    a = s
        [B][COLOR=Royalblue]Do[/COLOR][/B] [B][COLOR=Royalblue]While[/COLOR][/B] va(s, [COLOR=crimson]1[/COLOR]) = va(s + [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR])
        s = s + [COLOR=crimson]1[/COLOR]
        [B][COLOR=Royalblue]Loop[/COLOR][/B]

        Randomize
        n = s - a + [COLOR=crimson]1[/COLOR]

        [B][COLOR=Royalblue]Set[/COLOR][/B] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
            k = [COLOR=crimson]0[/COLOR]
                y = [COLOR=crimson]0[/COLOR]
        [B][COLOR=Royalblue]Do[/COLOR][/B]
            dSum = [COLOR=crimson]0[/COLOR]
            [B][COLOR=Royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]
                arr(i) = Int(Rnd() * [COLOR=crimson]3[/COLOR])
                dSum = dSum + arr(i)
            [B][COLOR=Royalblue]Next[/COLOR][/B]
            
            [B][COLOR=Royalblue]If[/COLOR][/B] dSum = va(s, [COLOR=crimson]1[/COLOR]) [B][COLOR=Royalblue]Then[/COLOR][/B]
                
                txt = [COLOR=brown]""[/COLOR]
                [B][COLOR=Royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]
                    txt = txt & arr(i)
                [B][COLOR=Royalblue]Next[/COLOR][/B]
                
                [B][COLOR=Royalblue]If[/COLOR][/B] [B][COLOR=Royalblue]Not[/COLOR][/B] d.Exists(txt) [B][COLOR=Royalblue]Then[/COLOR][/B]
                    d(txt) = [COLOR=brown]""[/COLOR]
                    j = j + [COLOR=crimson]1[/COLOR]
                    k = k + [COLOR=crimson]1[/COLOR]
                        [B][COLOR=Royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=Royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]
                            vb(j, i) = arr(i)
                        [B][COLOR=Royalblue]Next[/COLOR][/B]
                [B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]If[/COLOR][/B]
            
            [B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]If[/COLOR][/B]
            
            y = y + [COLOR=crimson]1[/COLOR]
            
        [B][COLOR=Royalblue]Loop[/COLOR][/B] [B][COLOR=Royalblue]Until[/COLOR][/B] k = n [B][COLOR=Royalblue]Or[/COLOR][/B] y > [COLOR=crimson]100000[/COLOR]
        
[B][COLOR=Royalblue]Next[/COLOR][/B]

Range([COLOR=brown]"F5"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]7[/COLOR]) = vb
[B][COLOR=Royalblue]End[/COLOR][/B] [B][COLOR=Royalblue]Sub[/COLOR][/B]
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
motilulla said:
...,but now i want as per post#16 is it possible?
Click to expand...

You seem to be incrementally adding requirements. Perhaps you can jump to the end and explain what your final goal is?
 
Upvote 0
Akuini said:
Try this:
Assuming header is at row 4 & data start at row 5:

Code: 
[B][COLOR=royalblue]Sub[/COLOR][/B] a1079591a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1079591-vba-random-numbers-generator-required-sum.html[/COLOR][/I]
[B][COLOR=royalblue]Dim[/COLOR][/B] arr([COLOR=crimson]1[/COLOR] [B][COLOR=royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]), d [B][COLOR=royalblue]As[/COLOR][/B] [B][COLOR=royalblue]Object[/COLOR][/B]
[B][COLOR=royalblue]Dim[/COLOR][/B] i [B][COLOR=royalblue]As[/COLOR][/B] [B][COLOR=royalblue]Long[/COLOR][/B], j [B][COLOR=royalblue]As[/COLOR][/B] [B][COLOR=royalblue]Long[/COLOR][/B], k [B][COLOR=royalblue]As[/COLOR][/B] [B][COLOR=royalblue]Long[/COLOR][/B]
[B][COLOR=royalblue]Dim[/COLOR][/B] dSum [B][COLOR=royalblue]As[/COLOR][/B] [B][COLOR=royalblue]Long[/COLOR][/B], txt [B][COLOR=royalblue]As[/COLOR][/B] [B][COLOR=royalblue]String[/COLOR][/B]

rr = Range([COLOR=brown]"M"[/COLOR] & Rows.count).[B][COLOR=royalblue]End[/COLOR][/B](xlUp).Row + [COLOR=crimson]1[/COLOR]
va = Range([COLOR=brown]"M5:M"[/COLOR] & rr)
[B][COLOR=royalblue]ReDim[/COLOR][/B] vb([COLOR=crimson]1[/COLOR] [B][COLOR=royalblue]To[/COLOR][/B] UBound(va, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [B][COLOR=royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR])

[B][COLOR=royalblue]For[/COLOR][/B] s = [COLOR=crimson]1[/COLOR] [B][COLOR=royalblue]To[/COLOR][/B] UBound(va, [COLOR=crimson]1[/COLOR]) - [COLOR=crimson]1[/COLOR]
    
    a = s
        [B][COLOR=royalblue]Do[/COLOR][/B] [B][COLOR=royalblue]While[/COLOR][/B] va(s, [COLOR=crimson]1[/COLOR]) = va(s + [COLOR=crimson]1[/COLOR], [COLOR=crimson]1[/COLOR])
        s = s + [COLOR=crimson]1[/COLOR]
        [B][COLOR=royalblue]Loop[/COLOR][/B]

        Randomize
        n = s - a + [COLOR=crimson]1[/COLOR]

        [B][COLOR=royalblue]Set[/COLOR][/B] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
            k = [COLOR=crimson]0[/COLOR]
                y = [COLOR=crimson]0[/COLOR]
        [B][COLOR=royalblue]Do[/COLOR][/B]
            dSum = [COLOR=crimson]0[/COLOR]
            [B][COLOR=royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]
                arr(i) = Int(Rnd() * [COLOR=crimson]3[/COLOR])
                dSum = dSum + arr(i)
            [B][COLOR=royalblue]Next[/COLOR][/B]
            
            [B][COLOR=royalblue]If[/COLOR][/B] dSum = va(s, [COLOR=crimson]1[/COLOR]) [B][COLOR=royalblue]Then[/COLOR][/B]
                
                txt = [COLOR=brown]""[/COLOR]
                [B][COLOR=royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]
                    txt = txt & arr(i)
                [B][COLOR=royalblue]Next[/COLOR][/B]
                
                [B][COLOR=royalblue]If[/COLOR][/B] [B][COLOR=royalblue]Not[/COLOR][/B] d.Exists(txt) [B][COLOR=royalblue]Then[/COLOR][/B]
                    d(txt) = [COLOR=brown]""[/COLOR]
                    j = j + [COLOR=crimson]1[/COLOR]
                    k = k + [COLOR=crimson]1[/COLOR]
                        [B][COLOR=royalblue]For[/COLOR][/B] i = [COLOR=crimson]1[/COLOR] [B][COLOR=royalblue]To[/COLOR][/B] [COLOR=crimson]7[/COLOR]
                            vb(j, i) = arr(i)
                        [B][COLOR=royalblue]Next[/COLOR][/B]
                [B][COLOR=royalblue]End[/COLOR][/B] [B][COLOR=royalblue]If[/COLOR][/B]
            
            [B][COLOR=royalblue]End[/COLOR][/B] [B][COLOR=royalblue]If[/COLOR][/B]
            
            y = y + [COLOR=crimson]1[/COLOR]
            
        [B][COLOR=royalblue]Loop[/COLOR][/B] [B][COLOR=royalblue]Until[/COLOR][/B] k = n [B][COLOR=royalblue]Or[/COLOR][/B] y > [COLOR=crimson]100000[/COLOR]
        
[B][COLOR=royalblue]Next[/COLOR][/B]

Range([COLOR=brown]"F5"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]7[/COLOR]) = vb
[B][COLOR=royalblue]End[/COLOR][/B] [B][COLOR=royalblue]Sub[/COLOR][/B]
Click to expand...
Wow Akuini, truly appreciated your kind help this is solved, as I wanted macro is giving performance 100% perfect!! </SPAN></SPAN>

Have a great weekend and good luck to you.</SPAN></SPAN>

Kind Regards,</SPAN></SPAN>
Moti :biggrin:</SPAN></SPAN>
 
Upvote 0
motilulla said:
Wow Akuini, truly appreciated your kind help this is solved, as I wanted macro is giving performance 100% perfect!!

Have a great weekend and good luck to you.

Kind Regards,
Moti :biggrin:
Click to expand...

You're welcome.
But I need you to add the blue line below. In case the loop is endless then it will warn you & exit the sub.


Code: 
        Loop Until k = n Or y > 100000
        
        [COLOR=#0000ff]If y > 100000 Then MsgBox "Something is wrong in row " & j + 5, vbCritical: Exit Sub[/COLOR]
        
Next
 
Upvote 0
Akuini said:
You're welcome.
But I need you to add the blue line below. In case the loop is endless then it will warn you & exit the sub.


Code: 
        Loop Until k = n Or y > 100000
        
        [COLOR=#0000ff]If y > 100000 Then MsgBox "Something is wrong in row " & j + 5, vbCritical: Exit Sub[/COLOR]
        
Next
Click to expand...
Akuini, thank you line added as you propose </SPAN></SPAN>

Kind Regards</SPAN></SPAN>
Moti</SPAN></SPAN>
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question
Vba - generate random alphanumeric strings based on user input
Replies
1
Views
227
DanteAmor
DanteAmor
J
  • Solved
Vba code to generate a list of numbers in random order
Replies
4
Views
379
Fluff
Fluff
S
  • Question
Splitting text into only two cells ?
Replies
4
Views
179
Peter_SSs
Peter_SSs
C
  • Question
Excel generate random number based on array and condition
Replies
5
Views
975
alansidman
A
T
  • Solved
Random number generator button
Replies
3
Views
784
Georgiboy
Georgiboy

Forum statistics

Threads
1,216,077
Messages
6,128,685
Members
449,463
Latest member
Jojomen56

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top