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