Random numbers - Help, please.

[SteveL]

I need to create a spreadsheet with 1,398,950 integers,
69,948 of which need to be marked as winners at random.

The end result needs to look like this... (each number is
a cell by itself...

0 0 0 0 1 0 0 0 0 0
0 1 0 0 0 0 1 1 0 0
etc.

The spreadsheet can only have 10 integers in a row which
the "0"'s representing a looser, and the "1"s
representing a winner.

I need a total of 139,895 rows of 10 integers and 69,948
winners marked.

I probably can't do this in one spreadsheet due the the
row count limitation in Excel so I'd have to do it with a
few spreadsheets.

Can anyone help me?

 

[Frank Kabel]

Hi Steve
somehow I remeber I provided a quite similar thing to you some weeks
ago 8not using only ten columns but all 256 columns). Is this
restriction required (otherwise the winner assignment get a little bit
complicated as it has to span multiple worksheets.

 

[Guest]

Frank,

Thanks for the quick reply. Yes, this restriction is
required. However, if you could guide me through the
first creation I could run it as many times as I needed
to to end up with the final integer and winner count.

--Steve

 

[Frank Kabel]

Hi
you may try the following macros (not fully tested and my Excel broke
after creating 16 sheets of your base sheets with 65000 rows filled for
each -> you'll need 22 worksheets and my current test workbook is
approx 100 MB large!!). But try it

Sub create_spreadsheets()
Dim i As Integer
Dim wks As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For i = 22 To 1 Step -1
If i <> 22 Then
ActiveWorkbook.Worksheets.Add
Set wks = ActiveSheet
wks.Name = "winning_" & i
wks.Range(Cells(1, 1), Cells(65000, 10)).Value = 0
Else
ActiveWorkbook.Worksheets.Add
Set wks = ActiveSheet
wks.Name = "winning_" & i
wks.Range(Cells(1, 1), Cells(26991, 10)).Value = 0
End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub





Sub assign_winners()
Dim row_index As Integer
Dim column_index As Integer
Dim cell_number As Long
Dim random_winner
Dim test As Boolean
Dim wks_name_index As Integer
Dim wks As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For cell_number = 1 To 69600
test = False
Do While Not test
random_winner = Int(1391991 * Rnd + 1)
wks_name_index = Int(random_winner / 65000) + 1
column_index = random_winner Mod 10 + 1
row_index = Int(random_winner / (65000 * 10)) + 1
Set wks = Worksheets("winning_" & wks_name_index)
If Not wks.Cells(row_index, column_index).Value <> "" Then
wks.Cells(row_index, column_index).Value = 1
test = True
End If
Loop
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[Frank Kabel]

Hi
one error. Change the following line in the second macro:
If Not wks.Cells(row_index, column_index).Value <> "" Then

to
If wks.Cells(row_index, column_index).Value =0 Then

 

[SteveL]

Frank,

I'm really sorry to bother you with this but I can't make
it run. Could you perhaps furnish the code to me to just
do the folowwing:

Create one spreadsheet like this...

0 0 0 0 1 0 0 0 0 0
0 1 0 0 0 0 1 1 0 0
etc.

With 20,000 rows of 10 integers per row and with 21,845
randomly placed "1"s in those 200000 possible cells?
From there I can get what I need.

Thanks again,

Steve

 

[Frank Kabel]

Hi
sou you also run into memory problems. Try the following:
Sub create_spreadsheets()
Dim i As Integer
Dim wks As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

ActiveWorkbook.Worksheets.Add
Set wks = ActiveSheet
wks.Name = "winning_1"
wks.Range(Cells(1, 1), Cells(200, 10)).Value = 0

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub





Sub assign_winners()
Dim row_index As Integer
Dim column_index As Integer
Dim cell_number As Long
Dim random_winner
Dim test As Boolean
Dim wks_name_index As Integer
Dim wks As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For cell_number = 1 To 21845
test = False
Do While Not test
random_winner = Int(200000 * Rnd + 1)
wks_name_index = 1
column_index = random_winner Mod 10 + 1
row_index = Int(random_winner / 10) + 1
Set wks = Worksheets("winning_" & wks_name_index)
If wks.Cells(row_index, column_index).Value <> 0 Then
wks.Cells(row_index, column_index).Value = 1
test = True
End If
Loop
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[SteveL]

Frank,

This doesn't seem to work. Hmmm.

--Steve

 

[Frank Kabel]

Hi Steve
what error did you get (please detailed error description