Option Compare Database
Option Explicit

Private Const upperBound = 10000000

Dim ws As DAO.Workspace
Dim rs As Recordset

Private Sub btnGetPrimeNumbers_Click()

    ' stats
    Dim numberToCheck As Long
    Dim startRun As Date
    Dim endRun As Date
    Dim largestPN As Long

    Dim timingData(4) As String

    ' data handling
    Dim primeNumArray()
    Dim primeNumberCount As Long
    Dim removeNumbers As Long

    startRun = Now
    lblStatus.SetFocus
    lblStatus.Text = "Finding Prime Numbers": DoEvents

    timingData(0) = Now & " - Create array"

    ' create the holding array
    primeNumberCount = upperBound
    ReDim primeNumArray(2 To upperBound + 1, 1 To 2)
    For numberToCheck = 2 To upperBound
        primeNumArray(numberToCheck, 1) = True
        primeNumArray(numberToCheck, 2) = numberToCheck
    Next numberToCheck

    ' remove the multiples of
    timingData(1) = Now & " - remove non-prime and write to table"
    For numberToCheck = 2 To Sqr(upperBound)

        ' is the number is in the string
        If primeNumArray(numberToCheck, 1) Then
            For removeNumbers = numberToCheck * numberToCheck To upperBound Step numberToCheck
                ' set to false and remove 1 from the array count if it is still set to true
                If primeNumArray(removeNumbers, 1) Then
                    primeNumArray(removeNumbers, 1) = False
                    primeNumberCount = primeNumberCount - 1
                Else
                    rs.AddNew
                    rs(1) = primeNumArray(removeNumbers, 2)
                    rs.Update
                End If
            Next removeNumbers
        End If
    Next numberToCheck

    ws.CommitTrans
    rs.Close
    Set rs = Nothing

    ws.Close
    Set ws = Nothing

    timingData(2) = Now & " - find largest prime"

    ' loop backwards to find the highest number that is true
    For numberToCheck = upperBound To 2 Step -1
        If primeNumArray(numberToCheck, 1) Then
            largestPN = primeNumArray(numberToCheck, 2)
            Exit For
        End If

    Next numberToCheck

    endRun = Now
    lblStatus.Text = "": DoEvents

    timingData(3) = Now & " - done"

    ' fill in the form
    txtStartTime.SetFocus: txtStartTime.Text = Format(CDate(startRun), "mm/dd/yy hh:MM:ss")
    txtEndTime.SetFocus: txtEndTime.Text = Format(CDate(endRun), "mm/dd/yy hh:MM:ss")
    txtDuration.SetFocus: txtDuration.Text = DateDiff("s", startRun, endRun)
    txtCount.SetFocus: Me.txtCount.Text = primeNumberCount - 1
    txtLargest.SetFocus: Me.txtLargest.Text = largestPN

    Dim x As Integer
    For x = 0 To 3
        Me.List13.AddItem timingData(x)
    Next x

End Sub

Private Sub Form_Load()

    Dim x As Integer
    For x = 0 To Me.Controls.Count - 1
        If TypeOf Me.Controls(x) Is TextBox Then
            Me.Controls(x).SetFocus
            Me.Controls(x).Text = ""
        End If
    Next x

    Me.List13.RowSource = ""

    ' set up the table
    Set ws = DBEngine.Workspaces(0)

    ' delete the tblPrimes table if it exists
    On Error Resume Next
    CurrentDb.Execute "Drop Table tblPrimes;"

    On Error GoTo 0
    ' create the tblPrimes table
    CurrentDb.Execute "Create Table tblPrimes (ID AUTOINCREMENT PRIMARY KEY, PrimeNumber Long);"

    ' create the recordset
    Set rs = CurrentDb.OpenRecordset("tblPrimes", dbOpenTable)   ' get the table
    ws.BeginTrans

End Sub