Project Euler - Problem 23

Solution

This problem cried out for one to adapt the Sieve of Eratosthenes technique in which one creates a list of all numbers and then zeros out those elements that meet a particular requirement.  In the original sieve, the criterion was non-primality.  In this problem, we will apply two sieves, the first to identify abundant numbers, the second to identify numbers that are not the sum of two abundant numbers.  In the first sieve, we don't zero out elements.  Instead, we add non-zero elements that meet our criterion.  In the second sieve, we zero out elements that are the sum of 2 abundant numbers (thereby leaving as non-zero all those numbers that are *not* the sum of two abundant numbers.

The first part of the code generates the list of abundant numbers.  The second part of the code removes all numbers that are the sum of abundant numbers.  Note that each nested loop searches only through those numbers that yield results less than or equal to 28123^*.  The code runs in about 2 seconds on my Core 2 Duo laptop.

For the getFactors function see the Euler Support page.

Sub Euler023()
    Const cLim As Integer = 28123
    Dim AbundantNbrs(cLim) As Boolean, AbundantSums(cLim) As Integer
    Dim I As Integer, J As Integer
    Dim StartTime As Single
    StartTime = Timer
    For I = 0 To UBound(AbundantNbrs)
        AbundantSums(I) = I
        Next I
    'The first abundant number is 12 and, according to Wikipedia, _
     all multiples of an abundant number are abundant numbers themselves
    For I = 12 To UBound(AbundantNbrs)
        If AbundantNbrs(I) Then
        ElseIf Sum(getFactors(I)) - I > I Then
            AbundantNbrs(I) = True
            For J = 2 To cLim \ I
                AbundantNbrs(I * J) = True
                Next J
            End If
        Next I
    'Debug.Print Timer - StartTime
    For I = 1 To UBound(AbundantNbrs) \ 2
    If AbundantNbrs(I) Then
        For J = I To cLim - I
            If AbundantNbrs(J) Then
                AbundantSums(I + J) = 0
                End If
            Next J
        End If
        Next I
    Debug.Print Timer - StartTime & "," & Sum(AbundantSums)
    End Sub