Random number generation without repeating across same row or column?

Simtech76

New Member
Joined
Nov 24, 2011
Messages
10
Hello,

Been trying to think of a way to get random numbers 1 to 36 generated without repeating in the same column, however also getting it to perform the same opertaion in 9 more columns (B:J) without the same number appearing in the same row.

example

1 2 5 4
2 5 3 1
3 4 1 5
4 1 2 3
5 3 4 2

Unsure if this is possible, have created a basic script for random number generation but have no clue how to expand across columns.

Thanks, Simon
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG24Nov09
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] oRnd [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]For[/COLOR] Ac = 2 To 10
   [COLOR="Navy"]Set[/COLOR] Rng = Range(Cells(1, Ac), Cells(36, Ac))
      c = 0
    [COLOR="Navy"]Do[/COLOR] Until c = 36
    Randomize
    oRnd = Int(Rnd * 36) + 1
        [COLOR="Navy"]If[/COLOR] Application.CountIf(Rng, oRnd) = 0 [COLOR="Navy"]Then[/COLOR]
            c = c + 1
            Cells(c, Ac) = oRnd
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Loop[/COLOR]
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

gardnertoo

Well-known Member
Joined
Jul 24, 2007
Messages
938
MickG, your solution resulted in numbers repeating across a given row when I ran it.

SimTech, I've got a solution for you, a hybrid of worksheet formula and macro which allowed me to generate a good deal more than the nine columns you requested. In several cases I was able to generate 33 columns before failing on column 34! As it is theoretically possible to have a full 36 x 36 matrix meeting your criteria, I consider a 36 x 33 to be pretty good. The way it works is by using worksheet formulas to choose a random number, and the macro to post that number to the results matrix. The formulas iterate based on the location of the first empty row in the current working column of the results matrix. The macro works it's way down a column, going row by row filling it with random numbers generated by the cell formulas. This random number is not chosen from the whole "1-36" pool, but from a selected pool containing only those numbers that are not already chosen in this column, AND not already chosen in this row. So for example, when you are choosing the fifth number in the eighth column, you eliminate from the pool the four numbers you've already chosen in this column AND the seven numbers previously chosen in the fifth row of the previous columns. For this specific example, this eliminates somewhere between seven and eleven numbers from consideration, as there will likely be some overlap (with more and more overlap as you get deeper in the results). At times, all 36 numbers will have been eliminated (this becomes more common the deeper you get), and the macro detects this and deletes the current column results and starts over.

Here's the code. Run the set_it_up code just once in a blank Sheet1 to build the formulas and named ranges, then run the step_after_step macro to build the results:
Code:
Sub set_it_up()
'Visuals
Columns("A:AK").ColumnWidth = 3
Columns("AL:AQ").ColumnWidth = 0.5
Columns("AU:AV").ColumnWidth = 0.5

'Borders
With Range("B2:AK37").Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Range("B2:AK37").Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Range("B2:AK37").Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With
With Range("B2:AK37").Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
    .ColorIndex = xlAutomatic
End With


'Text
Range("AW1").Value = "Column:"
Range("AW2").Value = "Row:"
Range("AW3").Value = "Result:"
Range("AW4").Value = "Choices:"
Range("AR1").Value = "Pool"
Range("AS1").Value = "Unused"
Range("AT1").Value = "Remaining"

'Formulas
Range("AX1").FormulaR1C1 = "=COUNT(R[36]C[-48]:R[36]C[-13])+1"
Range("AX2").FormulaR1C1 = "=COUNT(OFFSET(RC[-49]:R[35]C[-49],0,R[-1]C))+1"
Range("AX3").FormulaR1C1 = _
    "=INDEX(R[-1]C[-4]:R[34]C[-4],INT(RAND()*COUNT(R[-1]C[-4]:R[34]C[-4]))+1)"
Range("AX4").FormulaR1C1 = "=COUNT(R[-2]C[-4]:R[33]C[-4])"
For i = 1 To 36
    Cells(i + 1, 44).Value = i
    Cells(1, i + 1).Value = i
    Cells(i + 1, 45).FormulaR1C1 = _
        "=((COUNTIF(OFFSET(R1C1,R2C50,R1C50,-R2C50,1),RC[-1])+COUNTIF(OFFSET(R1C1,R2C50,R1C50,1,-R1C50),RC[-1]))=0)*RC[-1]"
    Cells(i + 1, 46).FormulaR1C1 = "=SMALL(R2C45:R37C45,RC[-2]+COUNTIF(R2C45:R37C45,0))"
Next i

'Named ranges
Set wb = ActiveWorkbook
wb.Names.Add Name:="columnnum", RefersTo:="=Sheet1!$AX$1"
wb.Names.Add Name:="rownum", RefersTo:="=Sheet1!$AX$2"
wb.Names.Add Name:="result", RefersTo:="=Sheet1!$AX$3"
wb.Names.Add Name:="choices", RefersTo:="=Sheet1!$AX$4"
wb.Names.Add Name:="results", RefersTo:="=Sheet1!$B$2:$AK$37"
wb.Names.Add Name:="destination", RefersToR1C1:= _
        "=OFFSET(Sheet1!R1C1,Sheet1!R2C50,Sheet1!R1C50)"
wb.Names.Add Name:="thiscolumn", RefersToR1C1:= _
        "=OFFSET(Sheet1!R2C1:R37C1,0,Sheet1!R1C50)"


End Sub



Sub step_after_step()
Dim howmany, cleared As Integer

'Clear out the results from the last data run
Range("results").ClearContents

'How long to run?  1296 is a full 36 x 36 matrix
'                         324 is a 9 x 36 matrix
Do Until howmany = 324

'Are there any valid choices?  If not, this column must
'be reset and tried again.
If Range("choices").Value = 0 Then
    If cleared = 2000 Then Exit Sub   '1000 doesn't take too long
    howmany = howmany - Range("rownum").Value + 1
    Range("thiscolumn").ClearContents
    cleared = cleared + 1
    'Range("cleared").Value = cleared   'displays the count on the sheet
    
End If
Range("destination").Value = Range("result").Value
howmany = howmany + 1
Range("A2").Value = howmany
Loop

End Sub

As you can see, I like using named ranges a lot, and this project is no exception. This allows the step_after_step macro to be a little more understandable, and allowed me to move things around on the worksheet while I was building it (adding rows or columns for example) without "breaking" the macro. Here are the named ranges and what they're for, in the order they appear in the step_after_step macro:

"results" is the range B2:AK37 This is the big range of cells where the macro results will accumulate.

"choices" is the single cell AX4 This cell contains a formula counting how many numbers are available for cell AX3 to choose from. If this number is zero, there are no legal choices and the macro resets the current column and starts over.

"rownum" is the single cell AX2 This cell contains the formula counting the rows having a result in the working column, plus 1.

"thiscolumn" is a formula-defined range, counting the number of columns with completed data sets. This is how the macro knows which column to delete and retry if there are no legal choices for the first empty row of that column.

"destination" is a single cell formula-defined range which finds the empty cell to which the next result needs to be posted.

"result" is the single cell AX3 This cell contains the formula which chooses a number from a list of available numbers as described above.
 

Simtech76

New Member
Joined
Nov 24, 2011
Messages
10
Brilliant, thank you guys. The script easily allowed me to increase beyond 36 numbers which was my first hurdle :)

(y)(y)(y)
 

Simtech76

New Member
Joined
Nov 24, 2011
Messages
10

ADVERTISEMENT

You know it is quite hypnotic, have it displayed on my wall via projector. Setup conditional formats for number ranges - almost makes a cool light show in the dark :)
 

gardnertoo

Well-known Member
Joined
Jul 24, 2007
Messages
938
Yeah, it's super nerdy of me but I love watching macros like this run. Glad it worked for you!
 

CARBOB

Well-known Member
Joined
Jun 6, 2005
Messages
1,860

ADVERTISEMENT

Can this be adapted to 12 columns?
 

gardnertoo

Well-known Member
Joined
Jul 24, 2007
Messages
938
@Carbob: Yes it can. In the step_after_step macro, change the line
Code:
howmany = 324

to
Code:
howmany = 432

Any multiple of 36 will work there. If you use the max of 1296, which is 36 columns, it will give up after failing on 2000 laps, driven by the line
Code:
If cleared = 2000 Then Exit Sub
This usually occurs while searching for the 33rd or 34th column in my tests.
 

CARBOB

Well-known Member
Joined
Jun 6, 2005
Messages
1,860
@Carbob: Yes it can. In the step_after_step macro, change the line
Code:
howmany = 324

to
Code:
howmany = 432

Any multiple of 36 will work there. If you use the max of 1296, which is 36 columns, it will give up after failing on 2000 laps, driven by the line
Code:
If cleared = 2000 Then Exit Sub
This usually occurs while searching for the 33rd or 34th column in my tests.


Thank you. Another question, what would it take to change the number from 36 to 44?
 

gardnertoo

Well-known Member
Joined
Jul 24, 2007
Messages
938
@Carbob: I'll get back to you on that. I need to revise the set_it_up macro for a larger range of possible numbers, and the step_after_step macro to ask the user both "How many numbers" and "How many sets" before the math runs. This will make it as flexible as possible.

(This always happens to me, and I should know better. Any number I decide to hard-code, someone comes behind and asks "Instead of X, how about Y?"....)
 

Watch MrExcel Video

Forum statistics

Threads
1,123,307
Messages
5,600,869
Members
414,411
Latest member
Snowmanaus

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
Top