Optimering af kode

Hej
Jeg mangler forslag til hvordan nedenstående kode (generering af tilfældige tal til en tabel)kan optimeres.
Koden afvikles meget langsomt, hvis jeg som input vælger ex. 100.000 tal.
For at køre koden skal der oprettes en tabel "tblrndnr"  med 2 felter (long integer) recnr, randomnr.

smide nedenstående i et modul, og kør funktionen "start" fra en makro

Option Compare Database

Public Function RandomNumbers(Oevre As Long, _
  Optional Nedre As Long = 1, _
  Optional HvorMangeTal As Long = 1, _
  Optional Unik As Boolean = True)
 
    If HvorMangeTal > ((Oevre + 1) - (Nedre - 1)) Then Exit Function
    Dim x          As Long
    Dim n          As Long
    Dim colNumbers  As New Collection
    Dim taeller    As Long
   
    taeller = 1
    DoCmd.SetWarnings False
       
    With colNumbers
        For x = Nedre To Oevre
            .Add x
        Next x
        For x = 0 To HvorMangeTal - 1
            n = RandomNumber(0, colNumbers.count + 1)
            DoCmd.RunSQL "INSERT INTO tblrndnr ( Recnr, Randomnr ) SELECT '" & taeller & "','" & colNumbers(n) & "' "
            taeller = taeller + 1
            If Unik Then
                colNumbers.Remove n
            End If
        Next x
    End With
   
    DoCmd.SetWarnings True
    Set colNumbers = Nothing
 
End Function


Public Function RandomNumber(Oevre As Long, _
    Nedre As Long) As Long
   
    Randomize
    RandomNumber = Int((Oevre - Nedre + 1) * rnd + Nedre)
End Function



Public Function start()
Dim Oevre As Long
Dim Nedre As Long
Dim antaltal As Long
Dim svar As String
Dim taeller As String

'tabellen tømmes for records
sletposter


Oevre = InputBox("Indtast øvre grænse")
Nedre = InputBox("Indtast nedre grænse")
antaltal = InputBox("Hvor mange tal skal findes")
   
    If Oevre - Nedre + 1 < antaltal Then
        MsgBox ("Antal tal skal være lig med eller mindre end difference mellem øvre og nedre grænse")
        Exit Function
    End If

x = RandomNumbers(Oevre, Nedre, antaltal)

svar = MsgBox("Programmet er afviklet, og resultatet er skrevet til tabellen tblrndnr. Vil du åbne tabellen?", vbOKCancel)
    If svar = vbOK Then
        DoCmd.OpenTable "tblrndnr"
    End If

End Function

Public Function sletposter()
DoCmd.SetWarnings False
DoCmd.OpenQuery "qrydelete"
DoCmd.SetWarnings True
End Function