RANDOM NUMBERS

[SteveL]

I need to create a spreadsheet that consists of 1,391,991
cells, numbered from 1 through 1,391,991. (Whole numbers
only). Then, 69,600 of them need to be marked in the
next cell as "Winner". These 69,600 have to be chosen at
random amongst the 1,391,991 possibilities.

Any help much appreciated.

--Steve

 

[Frank Kabel]

Hi Steve
you may try the following macros (not fast but they probably will do /
not much testing though)

1. Create the initial Spreadsheet
- I use every odd row for your numbers and every even row for marking
the winning cells (that is the cell above)
Sub create_spreadsheet()
Dim row_index As Integer
Dim column_index As Integer
Dim cell_number As Long
column_index = 1
row_index = 1

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For cell_number = 1 To 1391991
Cells(row_index, column_index).Value = cell_number
Cells(row_index + 1, column_index).Value = ""
If column_index = 256 Then
column_index = 1
row_index = row_index + 2
Else
column_index = column_index + 1
End If
Next

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



2. Assign the winners

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
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For cell_number = 1 To 69600
test = False
Do While Not test
random_winner = Int(1391991 * Rnd + 1)
column_index = random_winner Mod 256 + 1
row_index = Int(random_winner / 256) * 2 + 2
If Not Cells(row_index, column_index).Value <> "" Then
Cells(row_index, column_index).Value = "X"
test = True
End If
Loop
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Both not optimized for speed but (hopefully) working

 

[Frank Kabel]

Hi
you have to change the following declaration in both procedures:
Dim row_index As Integer
to
Dim row_index As Long