nth Composite Number UDF

[Juggler_IN]

I am looking for a UDF to compute the nth composite number (nth non-prime number) similar to the nth prime.

for e.g.,
1st prime number is 2. 1st composite is 4.
10th prime number is 29. 10th composite is 18.
100th prime number is 541. 100th composite is 133.

 

[Eric W]

Here's a UDF that calculates either:

Public Primality As String


Public Function NumType(ByVal ntype As String, ByVal loc As Long)
Dim i As Long, j As Long, a As Long, n As Long, x As Long


    If Len(Primality) = 0 Then Primality = "XP"
    
    ntype = UCase(ntype)
    If ntype <> "P" And ntype <> "C" Then
        NumType = "Invalid code"
        Exit Function
    End If
    
ChkAgain:
    a = 0
    For i = 2 To Len(Primality)
        If Mid(Primality, i, 1) = ntype Then
            a = a + 1
        End If
        If a = loc Then
            NumType = i
            Exit Function
        End If
    Next i
        
    n = Len(Primality) + 1
    If n > 1000000 Then
        NumType = "The requested value is over 1000000"
        Exit Function
    End If
    
    Primality = Primality & String(1000, "P")
    For i = 2 To Len(Primality)
        If Mid(Primality, i, 1) = "P" Then
            x = Int(n / i) * i
            x = IIf(x = 0, i, x)
            x = IIf(x <= i, i * 2, x)
            For j = x To Len(Primality) Step i
                Mid(Primality, j, 1) = "C"
            Next j
        End If
    Next i
    GoTo ChkAgain:
    
End Function

You call it like so:

Book1
	A	B
2	2	4
3	3	6
4	5	8
5	7	9
6	11	10
7	13	12
8	17	14
9	19	15
10	23	16
11	29	18
Sheet3

Cell Formulas
Range	Formula
A2	=numtype("P",ROWS($B$2:$B2))
B2	=numtype("C",ROWS($C$2:$C2))

It uses memoization to store previously computed results so it doesn't have to recompute every time. I put an upper limit of 1000000 on it, but you can change that if you like. It uses a version of the Sieve of Eratosthenes to calculate the primes. If the next requested function exceeds the number of primes/composites already calculated, it adds another 1000 numbers and tries again (up to 1000000).

Let us know if this works for you.

 

[Eric W]

A few tweaks to it to improve performance:

Public Primality As String

Public Function NumType(ByVal ntype As String, ByVal loc As Long)
Dim i As Long, j As Long, n As Long, x As Long, p2 As String

    If Primality = "" Then Primality = "XP"
    
    ntype = UCase(ntype)
    If ntype <> "P" And ntype <> "C" Then
        NumType = "Invalid code"
        Exit Function
    End If
    
ChkAgain:
    p2 = WorksheetFunction.Substitute(Primality, ntype, "~", loc)
    x = InStr(p2, "~")
    If x > 0 Then
        NumType = x
        Exit Function
    End If
        
    n = Len(Primality) + 1
    If n > 1000000 Then
        NumType = "The requested value is over 1000000"
        Exit Function
    End If
    
    Primality = Primality & String(1000, "P")
    For i = 2 To Len(Primality)
        If Mid(Primality, i, 1) = "P" Then
            x = Int(n / i) * i
            x = IIf(x <= i, i * 2, x)
            For j = x To Len(Primality) Step i
                Mid(Primality, j, 1) = "C"
            Next j
        End If
    Next i
    GoTo ChkAgain:
    
End Function

 

[Juggler_IN]

This meets the first part as it does output both primes and composites. What i also need is the nth value. Say if I input n=4, then it should output 4th prime = 7 and 4th composite = 9.

 

[Eric W]

It does that. Enter:

=NumType("P",4)

and it will return 7.

=NumType("C",4)

returns 9. Perhaps the fact that I used ROWS() to generate 1,2,3,4, etc. was confusing.

 

[Juggler_IN]

@Eric W;

This does give the output, but is failing at a higher LOC value. It gives output for C at 10000 but is failing for P at 10000. It starts to fail for C at 30000.

 

[Eric W]

The problem is that the Worksheet function Substitute, which I used in the macro, only allows up to 32767 characters. I replaced it with the VBA Replace function, which is too bad, since it's slower. But here's the updated version. I changed the lines in red:

Public Primality As String

Public Function NumType(ByVal ntype As String, ByVal loc As Long)
Dim i As Long, j As Long, n As Long, x As Long, p2 As String

    If Primality = "" Then Primality = "XP"

    ntype = UCase(ntype)
    If ntype <> "P" And ntype <> "C" Then
        NumType = "Invalid code"
        Exit Function
    End If
    
ChkAgain:
    p2 = Replace(Primality, ntype, "~", , loc - 1)
    x = InStr(p2, ntype)
    If x > 0 Then
        NumType = x
        Exit Function
    End If
        
    n = Len(Primality) + 1
    If n > 1000000 Then
        NumType = "The requested value is over 1000000"
        Exit Function
    End If
    
    Primality = Primality & String(10000, "P")
    For i = 2 To Len(Primality)
        If Mid(Primality, i, 1) = "P" Then
            x = Int(n / i) * i
            x = IIf(x <= i, i * 2, x)
            For j = x To Len(Primality) Step i
                Mid(Primality, j, 1) = "C"
            Next j
        End If
    Next i
    GoTo ChkAgain:

End Function