How to find the recurring period string of a recurring decimal using VBA

Juggler_IN

Active Member
Joined
Nov 19, 2014
Messages
347
Office Version
  1. 2003 or older
Platform
  1. Windows
I want to find the recurring period string of a recurring decimal.

That is, for example:
1/3 = 0.(3) = 0.333333... with a period "3" of length 1.
1/7 = 0.(142857) = 0.142857142857... with a period "142857" of length 6.
1/15 = 0.0(6) = 0.066666... with a period "6" of length 1.

So, if my input string is x=0.142857142857142857142, the code should output 142857.

I have attempted a VBA function with a reference Java code at Periods and the code is:

VBA Code:
Function findSequence(x As String) As String

    Dim n As Long, i As Long, j As Long, k As Long

    n = Len(x)

    For i = 1 To n - 1

        For j = i To n - 1

            k = j Mod i: If k = 0 Then k = 1 Else k = k

            If Mid(x, k, 1) <> Mid(x, j, 1) Then
                i = j
            Else
            End If

        Next j

        findSequence = Mid(x, 1, i + 1) ' (The issue appears to be at this line.)
        GoTo x1

    Next i

    findSequence = "Impossible"
    GoTo x1

x1:
    Exit Function

End Function

But, this code is not giving the required output. Any suggestions?
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Here's my take on this.

I've converted text to numbers to speed up processing, and assumed that you will strip leading zeros.

I have also allowed partial matches, e.g. for 1231231, or 12312312, the answer suggested is 123. If you want to insist on full matches, e.g. 123123 or 123123123 or 123123123 etc, you can add a condition requiring M/L to be integer, where M is the string length, and L is the sub-string length being tested.

AB
1Possible
2StringRecurring?
3111
412112
512312312123
61212112
7121231212123
8142857142857142857
91428571428142857
109919929991992
111212312123121231212123
Sheet1
Cell Formulas
RangeFormula
B3:B11B3=FindSequence(A3)


VBA Code:
Function FindSequence(s As String) As String
    
    Dim N() As Long, M As Long, i As Long, L As Long, j As Long, k As Long
    Dim bSuccess As Boolean
    
    M = Len(s)
    ReDim N(1 To M)
    
    For i = 1 To M
        N(i) = Mid(s, i, 1)
    Next i
    
    For L = 1 To M - 1
        For j = 1 To Application.RoundUp(M / L, 0) - 1
            For k = 1 To Application.Min(L, M - j * L)
                If N(k) <> N(j * L + k) Then
                    L = j * L + k - 1
                    GoTo EndLoop
                End If
            Next k
        Next j
        bSuccess = True
        GoTo EndFunction
EndLoop:
    Next L
    
EndFunction:
    FindSequence = IIf(bSuccess, Left(s, L), "n/a")
    
End Function
 
Upvote 0
Is it three full stops (Char 46) or an ellipsis (Char 133)?
 
Upvote 0
@StephenCrump; ... the code addresses one type of non-terminating decimal that has only a period in its expansion.

Meets examples, like 1/3 (0.333333), 1/7 (0.142857) .... these expansions have a period only after the decimal point. 0. followed by (3) and (142857).

But, it does not address expansions that have a pre-period before a period. Example, the decimal of 1/15 = 0.066666... = 0.0(6) and the decimal of 3227/555 which outputs 5.8144144144... = 5.8(144) ... here 144 is repeating infinitely and is the period and 8 is the period.

And, the command ?FindSequence("814414414") outputs n/a but the desired output is 144.
 
Upvote 0
Another loop should allow for these possibilities. Try this:

AB
1Possible
2StringRecurring?
31428571428142857
49919929991992
51212312123121231212123
61234545454545
78144144144144
81666666
900778778778778
Sheet1
Cell Formulas
RangeFormula
B3:B9B3=FindSequence(A3)


VBA Code:
Function FindSequence(s As String) As String
   
    Dim N() As Long, M As Long, i As Long, L As Long, j As Long, k As Long, p As Long
    Dim bSuccess As Boolean
       
    For p = 0 To Len(s) - 2
        M = Len(s) - p
        ReDim N(1 To M)
       
        For i = 1 To M
            N(i) = Mid(s, i + p, 1)
        Next i
       
        For L = 1 To M - 1
            For j = 1 To Application.RoundUp(M / L, 0) - 1
                For k = 1 To Application.Min(L, M - j * L)
                    If N(k) <> N(j * L + k) Then
                        L = j * L + k - 1
                        GoTo EndLoop
                    End If
                Next k
            Next j
            bSuccess = True
            GoTo EndFunction
EndLoop:
        Next L
    Next p
   
EndFunction:
    FindSequence = IIf(bSuccess, Mid(s, p + 1, L), "n/a")
   
End Function

I haven't allowed for decimal points, but there's no reason to test any integer component for recurrence.
 
Last edited:
Upvote 0
@StephenCrump; is it possible to incorporate the auto-rounding of decimal cases?

What I mean is, for eg, 1/6 = 0.166666666666666666... which is reported by Excel as 0.166666666666667, and 1/7 = 142857142857142857142857... which is reported by Excel as 0.142857142857143.

In the case of 1/6 the last digit 6 is rounded up to 7 and with 1/7 the last digit 2 is rounded up to 3.
 
Upvote 0
I changed back to comparing strings - a digit by digit comparison won't work if we allow rounding to flow through.

I haven't tested properly, so give it a good workout and see if you can break it:

AB
1666666
26666676
359595959559
459595959659
51234512345123412345
61234512345123512345
71428571428142857
81428571429142857
99919929991992
101666666
11778778778778
123334n/a
1344445n/a
145555565
15199200n/a
1619950012001995001
Sheet1
Cell Formulas
RangeFormula
B1:B16B1=FindSequence(A1)


VBA Code:
Function FindSequence(s As String) As String
  
    Dim L As Long, M As Long, p As Long
    Dim test1 As String, test2 As String, s1 As String
    Dim bSuccess As Boolean
    Const PREC = 15
      
    For p = 0 To Len(s) - 2
        s1 = Right(s, Len(s) - p)
        M = Len(s1)
        For L = 1 To M - 1
            test1 = Application.Rept(Left(s1, L), 1 + Int(M / L))
            test2 = ""
            If Mid(test1, M + 1, 1) > "4" Then test2 = Left(test1, Application.Max(0, M - PREC)) & Right(Left(test1, M), PREC) + 1
            If Left(test1, M) = s1 Or Left(test2, M) = s1 Then
                bSuccess = s1 <> 0
                GoTo EndFunction
            End If
        Next L
    Next p
  
EndFunction:
    FindSequence = IIf(bSuccess, Left(s1, L), "n/a")
      
End Function
 
Upvote 0

Forum statistics

Threads
1,212,933
Messages
6,110,752
Members
448,295
Latest member
Uzair Tahir Khan

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top