Following UDF is NOT yielding result. Could you please where the problem is?

Would request expertise of all the respected members, in the following post.
Following UDF is NOT yielding result. Could you please where the problem is?

Option Explicit
Private Function BBHTRRr() As Double
'By Bibek Bhattacharyya
Application.Volatile True
Application.Calculation = xlCalculationAutomatic

On Error GoTo ErrorSink

Dim j As Integer
j = 0

Dim RGuess As Double
Dim RLow As Double
Dim RHigh As Double
Dim LtLow As Double
Dim LtHigh As Double
Dim RtLow As Double
Dim RtHigh As Double
Dim DiffLow As Double
Dim DiffHigh As Double

RGuess = 1.25

Do

    j = j + 1

    RLow = RGuess * 0.99
    RHigh = RGuess * 1.01

    LtLow = RLow
    LtHigh = RHigh

    RtLow = Application.WorksheetFunction.Exp(0.936 * ((RLow / 97) * ((100 - (3 * RLow)) - 1)))
    RtHigh = Application.WorksheetFunction.Exp(0.936 * ((RHigh / 97) * ((100 - (3 * RHigh)) - 1)))

    DiffLow = (RtLow - LtLow)
    DiffHigh = (RtHigh - LtHigh)

    If DiffLow < 0 Then
        RLow = RLow - DiffLow
    ElseIf DiffLow > 0 Then
        RLow = RLow + DiffLow
    End If

    If DiffHigh < 0 Then
        RHigh = RHigh - DiffHigh
    ElseIf DiffHigh > 0 Then
        RHigh = RHigh + DiffHigh
    End If

    RGuess = (RLow + RHigh) / 2

Loop Until DiffLow <> 0 And DiffHigh <> 0 Or j < 1501

BBHTRRr = RGuess

Application.Volatile True
Application.Calculation = xlCalculationAutomatic

ErrorSink:
End Function