Create an UDF to get Odd, Even and Prime Numbers from a string

[Luthius]

Guys
I would like your support on how to extract from a string the numbers and count the quantity of
Odd Numbers, Even Numbers, Prime Numbers.

The string can come this way with "-" as delimiter.
1-2-3-4-5-6-7-8-9-10-11-12-13-14-15
3-6-7-11-173-14

[COLOR=#0000cd]Public Function[/COLOR] MyUDF(strNumbers [COLOR=#0000cd]As String[/COLOR], returnType [COLOR=#0000cd]As Integer[/COLOR])[COLOR=#008000] 
  
   '1=Odd Numbers[/COLOR]
[COLOR=#008000]    '2=Even Numbers[/COLOR]
[COLOR=#008000]    '3=Prime Numbers[/COLOR]
    [COLOR=#0000cd]Select Case[/COLOR] returnType
    [COLOR=#0000cd]Case[/COLOR] 1
[COLOR=#008000]        'Will return the quantity of Odd numbers[/COLOR]
    [COLOR=#0000cd]Case[/COLOR] 2
[COLOR=#008000]        'Will return the quantity of Even numbers[/COLOR]
    [COLOR=#0000cd]Case[/COLOR] 3
[COLOR=#008000]        'Will return the quantity of Prime numbers[/COLOR]
[COLOR=#0000cd]    End Select[/COLOR]
    
[COLOR=#0000cd]End Function[/COLOR]

 

[lrobbo314]

That 'Like' operator is smarter than I imagined.

It is not a good idea to use the VBA Mod operator (not Mod function) in a UDF as it will fail with sufficiently large enough numbers. The largest number the Mod operator can handle is 2147483647 (a Long data type) but Excel cells can contain numbers much greater than this, so if such a number is tested with the Mod operator, an Error message will be generated if not trapped (a similar problem exists for negative numbers). You do not have to fall back on using the Evaluate function to invoke Excel's MOD function though...

Even: If Number Like "*[02468]" Then

Odd: If Number Like "*[13579]" Then

 

[Luthius]

The largest number is 100.
By the way, is possible identify incrementing on this UDF the counting of Fibonacci sequence? How many numbers are in Fibonacci sequence as per string?

 

[Rick Rothstein]

The largest number is 100.

Since you show single digits with one leading zero and all other numbers in your examples are two digits... do your numbers range between 00 to 99 or 01 to 100?

By the way, is possible identify incrementing on this UDF the counting of Fibonacci sequence? How many numbers are in Fibonacci sequence as per string?

That should be possible, but in order to write the most efficient code to do it, we need to know if all the numbers in a cell are always sorted in increasing order as all of your examples show. In other words, a sequence like this is not possible because the 05 is out of place...

01-04-08-05-09

is that correct?

 

[Luthius]

Since you show single digits with one leading zero and all other numbers in your examples are two digits... do your numbers range between 00 to 99 or 01 to 100?

01 To 100

That should be possible, but in order to write the most efficient code to do it, we need to know if all the numbers in a cell are always sorted in increasing order as all of your examples show. In other words, a sequence like this is not possible because the 05 is out of place...

01-04-08-05-09

is that correct?

It is always sorted.

See the string in my example below
01-02-04-08-13-21-34-39-40-41-42-48-69-71-80
7 Odd Numbers (01,13,21,39,41,69,71)
8 Even Numbers
4 Prime Numbers (02,13,41,71)
4 Sequential Numbers (Blue Color)
01 Fibonacci sequence with 04 Numbers (Red Color)

 

[Rick Rothstein]

See the string in my example below
01-02-04-08-13-21-34-39-40-41-42-48-69-71-80
7 Odd Numbers (01,13,21,39,41,69,71)
8 Even Numbers
4 Prime Numbers (02,13,41,71)
4 Sequential Numbers (Blue Color)
01 Fibonacci sequence with 04 Numbers (Red Color)

First off, I count 2 Fibonacci sequences... 01-02 and 08-13-21-34 (obviously, single numbers are not to be counted as a sequence).

Given the above, here is a function that will return the count for odds, evens, primes, the count of the longest sequence or the count of the number of Fibonacci sequences depending on what you pass in for the second argument. The first argument is the string of numbers to be evaluated, the second argument only looks at the first letter of what you pass in (so, if you want the count for odd numbers, you can pass in "O", "Odds" or any other word starting with the letter "O"). The possible first letters for the second argument are "O" for odds, "E" for evens, "P" for primes, "S" for sequence and "F" for Fibonacci. Note the name of the function is OEPSF (which is just those argument letters joined together). Here is the function...

[table="width: 500"]
[tr]
	[td]Function OEPSF(S As String, OEPSorF As String) As Variant
  Dim N As Variant, X As Long, SEQ As String, FIB as string, Nums() As String
  Const PRIMEs As String = " 02 03 05 07 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 "
  Nums = Split(Replace(S, " ", ""), "-")
  Select Case UCase(Left(OEPSorF, 1))
    Case "O"
      For X = 0 To UBound(Nums)
        If Nums(X) Like "*[13579]" Then OEPSF = OEPSF + 1
      Next
    Case "E"
      For X = 0 To UBound(Nums)
        If Nums(X) Like "*[02468]" Then OEPSF = OEPSF + 1
      Next
    Case "P"
      For X = 0 To UBound(Nums)
        If InStr(PRIMEs, " " & Nums(X) & " ") Then OEPSF = OEPSF + 1
      Next
    Case "S"
      SEQ = Space(100)
      For X = 0 To UBound(Nums)
        Mid(SEQ, Nums(X)) = 1
      Next
      For Each N In Split(Application.Trim(SEQ))
        If Len(N) > OEPSF Then OEPSF = Len(N)
      Next
    Case "F"
      FIB = " 01 02 03 05 08 13 21 34 55 89 "
      For X = 0 To UBound(Nums)
        If InStr(FIB, " " & Nums(X) & " ") Then FIB = Replace(FIB, Nums(X), "X")
      Next
      For Each N In Split(FIB)
        If N <> "X" Then FIB = Replace(FIB, N, "")
      Next
      FIB = Replace(FIB, "X ", "X")
      For Each N In Split(FIB)
        If Len(N) > OEPSF Then OEPSF = OEPSF + 1
      Next
  End Select
End Function[/td]
[/tr]
[/table]

 

[Luthius]

Awesome guys. Thank you Rick Rothstein, lrobbo314 and kweaver too.
This is the best Excel forum!!!
You guys rock!

 

[lrobbo314]

Just to throw in my solution with the Fibonacci sequence added.

Public Function MyUDF(strNumbers As String, returnType As Integer)
Dim SP() As String: SP = Split(strNumbers, "-")
Dim Total As Integer
    '1=Odd Numbers
    '2=Even Numbers
    '3=Prime Numbers
    '4=Sequence
    '5=Fibonacci
    
For i = LBound(SP) To UBound(SP)
    Select Case returnType
    Case 1
        If Int(SP(i)) Mod 2 = 1 Then Total = Total + 1
    Case 2
        If Int(SP(i)) Mod 2 = 0 Then Total = Total + 1
    Case 3
        If ISPRIME(Int(SP(i))) Then Total = Total + 1
    Case 4
        MyUDF = SEQUENCE(SP)
        Exit Function
    Case 5
        MyUDF = FIBSEQ(SP)
        Exit Function
    End Select
Next i

MyUDF = Total
    
End Function

Function SEQUENCE(SP() As String) As Long
Dim Total As Long: Total = 1
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim High As Long

For i = LBound(SP) + 1 To UBound(SP)
    If Int(SP(i)) - 1 = Int(SP(i - 1)) Then
        Total = Total + 1
    Else
        If Total > 1 Then AL.Add Total
        Total = 1
    End If
Next i

AL.Add Total

For j = 0 To AL.Count - 1
    If AL(j) > High Then High = AL(j)
Next j

SEQUENCE = High

End Function

Function FIBSEQ(SP() As String) As Long
Dim Total As Long: Total = 1
Dim f As Object: Set f = CreateObject("System.Collections.ArrayList")
Dim pos As Integer
Dim cnt As Integer: cnt = 0

For Each n In Array("01", "02", "03", "05", "08", "13", "21", "34", "55", "89")
    f.Add n
Next n

For i = LBound(SP) To UBound(SP)
    pos = i + 1
    If f.indexof(SP(i), 0) > -1 And f.indexof(SP(i), 0) < f.Count - 1 Then
        For j = f.indexof(SP(i), 0) + 1 To f.Count
            If f(j) = SP(pos) Then
                Total = Total + 1
                pos = pos + 1
            Else
                If Total > 1 Then cnt = cnt + 1
                i = i + Total - 1
                Total = 1
                Exit For
            End If
        Next j
    End If
Next i

FIBSEQ = cnt

End Function

Function ISPRIME(Num As Double) As Boolean
    Dim i As Double
    If Num = 1 Then ISPRIME = False: Exit Function
    If Num = 2 Then ISPRIME = True: Exit Function
    If Int(Num / 2) = (Num / 2) Then
        Exit Function
        Else
        For i = 3 To Sqr(Num) Step 2
            If Int(Num / i) = (Num / i) Then
                Exit Function
            End If
        Next i
    End If
    ISPRIME = True
End Function