VBA random numbers generator with required sum

M

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
2,422
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

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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 :grin:</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 :grin:
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

A
  • Question Question
Random Number Generator That Can Exclude Numbers
Replies
2
Views
377
FormulasOnly
F
Dan Wilson
  • Solved
Help with the Random Function
Replies
7
Views
533
Fluff
Fluff
S
  • Question Question
Vba - generate random alphanumeric strings based on user input
Replies
1
Views
553
DanteAmor
DanteAmor
M
  • Solved
Sum the values between two specified column headings - number of columns between will change
2
Replies
14
Views
248
Moley84
M
J
  • Solved
Vba code to generate a list of numbers in random order
Replies
4
Views
729
Fluff
Fluff

Forum statistics

Threads
1,223,911
Messages
6,175,327
Members
452,635
Latest member
laura12345

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