Random number generation without repeating across same row or column?

[Simtech76]

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

 

[MickG]

Try this:-

[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]

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:

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]

Brilliant, thank you guys. The script easily allowed me to increase beyond 36 numbers which was my first hurdle

 

[Simtech76]

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]

Yeah, it's super nerdy of me but I love watching macros like this run. Glad it worked for you!

 

[CARBOB]

Can this be adapted to 12 columns?

 

[gardnertoo]

@Carbob: Yes it can. In the step_after_step macro, change the line

howmany = 324

to

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

If cleared = 2000 Then Exit Sub

This usually occurs while searching for the 33rd or 34th column in my tests.

 

[CARBOB]

@Carbob: Yes it can. In the step_after_step macro, change the line

howmany = 324

to

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

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]

@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?"....)