Error when implementing Newton Raphson method to vba

Question

This is a long one I know but I would really appreciate the help. I am trying to code the Newton Raphson method into VBA, Code shown below:

Code:

'Code illustrating Newton-Raphson scheme for the equation:
' f(x) = arcCos((x-BCos(H))/S)-arcSin((Bsin(H)-y)/S)

Const ep = 1E-23: Const imax = 100
Private x As Long: Private xnew As Single: Private xl As Single
Private xu As Single: Private xm As Single: Private xmold As Single: Private A As Single: Private B As Single
Private C As Single: Private D As Single
Private i As Integer
Private Failed As Boolean: Private Converged As Boolean

Sub Setup()
Failed = False
Converged = False
i = 0
End Sub

Sub NRRoot()
Set sht = Sheets("Sheet1")
For rw = 2 To 3601

x = sht.Cells(rw, 48)

Setup
Do
Dim fx As Single: Dim fprimex As Single
fx = Application.Acos((Range("O9") - Range("AI5") * Cos(x)) / Range("AL5")) - Application.Asin((Range("AI5") * Sin(x) - Range("P9")) / Range("AL5"))
fprimex = -(Range("AI5") * Sin(x) * Range("AL5")) / (Range("AL5") * Sqr((Range("AL5") ^ 2) - (Range("O9") ^ 2) + 2 * Range("O9") * Range("AI5") * Cos(x) - (Range("AI5") ^ 2) * (Cos(x) ^ 2))) - (Range("AI5") * Cos(x) * Range("AL5")) / (Range("AL5") * Sqr((Range("AL5") ^ 2) - (Range("AI5") ^ 2) * (Sin(x) ^ 2) + 2 * Range("P9") * Range("AI5") * Sin(x) - (Range("P9") ^ 2)))
xnew = x - fx / fprimex
Dim er As Single
er = Abs(2 * (xnew - x) / (xnew + x))
If er < ep Then
Converged = True
ElseIf i >= imax Then
Failed = True
Else
i = i + 1
x = xnew
End If
Loop Until Converged Or Failed
If Failed Then
sht.Cells(rw, 50).Value = "Iteration failed"
Else
sht.Cells(rw, 50).Value = xnew
End If
sht.Cells(rw, 51).Value = i
Next

End Sub

Problem:

I am getting the error message: "Run-time error'13': Type Mismatch", and using the debugger it is shown on this line of code:

fx = Application.Acos((Range("O9") - Range("AI5") * Cos(x)) / Range("AL5")) - Application.Asin((Range("AI5") * Sin(x) - Range("P9")) / Range("AL5"))

I think it has something to do with the Application.Acos & Application.Asin, however I am not too sure. I was having troubles with it for a while and I did some searching and found This showing that I have to put Application.Acos or Application.WorksheetFunction. The values being put in are all in radians from -pi to pi.

If it isn't because of the above text, then I think it could have something to do with the parameters that I am defining... right at the top there it says Private x As Long where maybe it has to be something else. I have tried troubleshooting, but it never really worked :(

The values in cells O9, P9, AI5, and AL5 are listed respectively: 2000, 3000, 5700, 2924.99

P.S. The reason why I am needing to use this method is because I am trying to calculate the angles of 2 sticks when given a certain point x,y (O9,P9). I need these angles to be able to calculate the center of mass of the two sticks. Once I have the center of mass I can then finish my calculations for the project I am doing. I know there are other (much better) methods to do this problem, like wolfram mathematica, however there are other parts to the project that need to be on excel. Therefore to run everything as smooth as possible, sadly, I need to do all of this on excel.

P.P.S. This is not my code by the way, I copied it from Here, however I think it does actually solve the Newton Raphson Method.

Solution

I had the numbers for arcSin starting at pi and going to -pi instead of 90 going to -90...

If I can figure out a better way to program the Newton Raphson Method, I will be sure to make a new post about it.

Answer 1

I split your codes into multiple subroutines and removed some unused variables. Run the Sub Main() will give the final results.

VBA itself has the sin and cos functions. You can use them as VBA.sin() and VBA.cos(), or simply sin() and cos(). The Acos and Asin are included in Application.WorksheetFunction, so you can use them as Application.WorksheetFunction.Acos and Application.WorksheetFunction.Asin.

In your original code of fprimex, there is an occurrence of Range("Cos(x)"), which is not the valid syntax for the Worksheet.Range property, unless you have a Range that has the name of "Cos(x)". Also, please check whether my version of fprimex matches yours since I haven't done calculus for some time.

You should be careful with cases when fPrimeX = 0, or abs(x) >= 1 when sqr(1-x^2) is on the denominator. Crude exit options for the above cases are include in the attached codes.

Option Explicit

Const ep As Double = 1E-23: Const iMax As Long = 100

Private FuncCoeffB As Double
Private FuncCoeffS As Double
Private FuncCoeffX As Double
Private FuncCoeffY As Double

Private sht As Worksheet
Private wksFunc As WorksheetFunction

Private Sub SetExcelVariables()
    Set sht = Application.ThisWorkbook.Worksheets(1)
    ' Set sht = Sheets("Sheet1")
    Set wksFunc = Application.WorksheetFunction
End Sub

Private Sub SetFunctionCoefficients()
    With sht
        FuncCoeffX = .Range("O9")
        FuncCoeffY = .Range("P9")

        FuncCoeffB = .Range("AI5")
        FuncCoeffS = .Range("AL5")
    End With
End Sub

Private Function fx(ArgX As Double) As Double
    Dim fx1 As Double
    Dim fx2 As Double

    If VBA.Abs((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) > 1 Or _
        VBA.Abs((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) > 1 Then

        Exit Function
    End If

    fx1 = wksFunc.Acos((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS)
    fx2 = -wksFunc.Asin((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS)

    fx = fx1 + fx2
End Function

Private Function fPrimeX(ArgX As Double) As Double
    Dim fPrimeX1 As Double
    Dim fPrimeX2 As Double

    If (((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) ^ 2) >= 1 Or _
        (((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) ^ 2) >= 1 Then

        Exit Function
    End If

    fPrimeX1 = _
        -FuncCoeffB / FuncCoeffS * VBA.Sin(ArgX) / _
        VBA.Sqr( _
            1 - ((FuncCoeffX - FuncCoeffB * VBA.Cos(ArgX)) / FuncCoeffS) ^ 2)

    fPrimeX2 = _
        -FuncCoeffB / FuncCoeffS * VBA.Cos(ArgX) / _
        VBA.Sqr( _
            1 - ((-FuncCoeffY + FuncCoeffB * VBA.Sin(ArgX)) / FuncCoeffS) ^ 2)

    fPrimeX = fPrimeX1 + fPrimeX2
End Function

Private Function NewtonRaphson(ByVal ArgX As Double) As Variant
    Dim ResFx As Double
    Dim ResFPrimeX As Double

    Dim xNew As Double
    Dim er As Double

    Dim iIter As Long
    Dim Converged As Boolean
    Dim Failed As Boolean

    Dim ReturnValue As Variant
    ReDim ReturnValue(1 To 1, 1 To 2) ' An array with a size of 1-by-2.

    Do
        ResFx = fx(ArgX)
        ResFPrimeX = fPrimeX(ArgX)

        If ResFPrimeX = 0 Then
            Failed = True
        Else
            xNew = ArgX - ResFx / ResFPrimeX
        End If

        If xNew + ArgX = 0 Then
            Failed = True
        Else
            er = VBA.Abs(2 * (xNew - ArgX) / (xNew + ArgX))
        End If

        If er < ep Then
            Converged = True
        ElseIf iIter >= iMax Then
            Failed = True
        Else
            iIter = iIter + 1
            ArgX = xNew
        End If
    Loop Until Converged Or Failed

    If Failed Then
        ReturnValue(1, 1) = "Iteration failed"
    Else
        ReturnValue(1, 1) = xNew
    End If

    ReturnValue(1, 2) = iIter

    NewtonRaphson = ReturnValue
End Function

Sub Main()
    Dim rw As Long
    Dim rngTarget As Excel.Range
    Dim rngResult As Excel.Range
    Dim xValue As Double

    Call SetExcelVariables
    Call SetFunctionCoefficients

    For rw = 2 To 12
        Set rngTarget = sht.Cells(rw, 48)
        xValue = rngTarget.Value

        Set rngResult = rngTarget.Offset(0, 2).Resize(1, 2)
        rngResult.Value = NewtonRaphson(xValue)
    Next rw
End Sub