Random numbers and drawing lots with Excel VBA

Sub LottoCheat()
'Draws lots from values in a table finding 7 different winning numbers.
'If a number occurs in the table more than once, the probability
'increases for this number to become a winner.

Dim lVal As Long
Dim rInput As Range
Dim rCell As Range
Dim colCheck As Collection
Dim colWinners As Collection

On Error GoTo ErrorHandle

'We assume that the table is on the first worksheet and starts in cell A1.
'The range, rInput is set = the table.
Set rInput = Worksheets(1).Range("A1").CurrentRegion

'Checks that there are at least 8 cells in the table.
If rInput.Count < 8 Then
   MsgBox "There are too few cells in the table.", vbCritical
   GoTo BeforeExit
End If

'Checks that the table contains numbers only and no empty cells.
For Each rCell In rInput
   If IsNumeric(rCell.Value) = False Or Len(rCell.Value) = 0 Then
      MsgBox "The cells must be numbers.", vbCritical
      GoTo BeforeExit
   End If
Next

On Error Resume Next

'Checks that there are at least 8 different values.
'This is done by adding the numbers to a collection
'as Keys. Collections will only accept unique keys,
'and "On Error Resume Next" (above) ensures that
'the program doesn't crash with an error, if a
'duplicate Key is added.
Set colCheck = New Collection
For Each rCell In rInput
   With rCell
      'The number is converted to an Integer and
      'a String, before being used as a Key.
      colCheck.Add Int(.Value), Str$(Int(.Value))
   End With
   'The loop stops, when there are
   '8 different values in colCheck.
   If colCheck.Count = 8 Then Exit For
Next

'If there are not 8 different values in the table, we exit.
If colCheck.Count < 8 Then
   MsgBox "There must be at least 8 different values in the table."
   GoTo BeforeExit
End If

Set colWinners = New Collection

'Resets the number generator, so it gets a new
'seed value from the computer's clock.
'About seed values see: http://en.wikipedia.org/wiki/Random_seed
Randomize

'We now find 7 random numbers between 1 and the number of
'cells in the table. The value in the cell with the
'corresponding item number in rInput is added to the
'collection colWinners. By adding the value as Key
'we ensure that there will be no duplicates
' - that is: Only one instance of each winning number.
For Each rCell In rInput
   With rInput
      'Generate a random Integer. The number
      'will be between 1 and the number of cells
      'in the table.
      lVal = Int(.Count * Rnd() + 1)

      'The value in the cell with the corresponding
      'random number in the range rInput, is added to
      'colWinners. If the number is already there, it
      'will not be added.
      colWinners.Add Int(.Item(lVal).Value), _
      Str$(Int(.Item(lVal).Value))
      If colWinners.Count = 7 Then Exit For
   End With
Next

On Error GoTo ErrorHandle

'The winning numbers are now inserted on Sheet 2.
Set rCell = Worksheets(2).Range("A1")
rCell.Value = "Winning lots:"
With colWinners
   For lVal = 1 To .Count
      rCell.Offset(lVal, 0).Value = .Item(lVal)
   Next
End With

'Activate the sheet with the winning lots:
Worksheets(2).Activate

BeforeExit:
Set rCell = Nothing
Set rInput = Nothing
Set colCheck = Nothing
Set colWinners = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure LottoCheat."
Resume BeforeExit
End Sub

Sub MakeUniqueTable()

'Makes a table with random and unique Integers.
'The trick to avoid duplicates is to add each number
'to a collection and at the same time use the number
'as Key. Keys in a collection must be unique, and
'if you try to add a duplicate key, it will
'trigger an error. This ensures that our table
'will have unique numbers.

'NOTE! With very large tables this can take a while, because
'the number generator will generate numbers that are already
'in the table, and then it takes extra time to finish.
'Usually the speed is so high that it doesn't matter,
'and you can reduce the probability for duplicates
'by increasing the interval for the random numbers.

Dim rTable As Range
Dim rCell As Range
Dim lMin As Long
Dim lMax As Long
Dim lVal As Long
Dim colValues As Collection

On Error GoTo ErrorHandle

'The table is defined as the range A1 to J30 on the first worksheet.
Set rTable = Worksheets(1).Range("A1", "J30")

'Define the interval (here 1 to 1000).
lMin = 1
lMax = 1000

'Check: The interval must be at least as
'big as the number of cells in the table.
If lMax - lMin < rTable.Count Then
   MsgBox "The interval is too small.", vbCritical
   GoTo BeforeExit
End If

'Reset the number generator so it gets a new seed value.
Randomize

Set colValues = New Collection

'The trick to getting unique values only is that we
'now set error handling to "Resume Next". Without
'doing that the program would crash if you tried to
'add an already existing key to the collection.
'Now the program just skips the duplicate and continues.

On Error Resume Next

'Now we start the loop that generates random numbers.
'The loop continues, until colValues has as many items
'as cells in the table, rTable.
Do Until colValues.Count = rTable.Count
   'lVal is set to a randow Integer in our defined interval.
   lVal = Int((lMax - lMin + 1) * Rnd() + lMin)

   'Add to colValues with the number as key.
   colValues.Add lVal, Str$(lVal)
Loop

On Error GoTo ErrorHandle

'Loop through colValues and write the values to the table.
With colValues
   For lVal = 1 To .Count
      rTable.Item(lVal).Value = .Item(lVal)
   Next
End With

BeforeExit:
Set rCell = Nothing
Set rTable = Nothing
Set colValues = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Procedure MakeUniqueTable."
Resume BeforeExit
End Sub