Help with solving non-linear equation with VBA

[eddytan95]

Hi,

I'm trying to code some coding in VBA in order to solve a non-linear equation

Below are my code and I have tried for hours and seems no luck for me. Can anyone guide me please?

What I'm trying to do was, input a range of number like, 1.000 to 2.000 which is equal to x, and the code guess the numbers between 1.000 to 2.000 which f(x)<=0.001 and f(x)>=-0.001, and show the x out in excel which are the roots of the equation.

The roots are
1.75 (range at x=0 to 2)
3.69 (range at x=2 to 4)
-3.69 (range at x=-4 to -2)
-1.75 (range at x=-2 to 0)

What I'm going to input in excel was =optima(0,2) and i expect the excel to show up 1.75, but it hangs there for more than 5 minutes and I just end the excel and restarting it.

Any advise?

Function optima(low As Double, up As Double)


Dim a As Double
Dim b As Double
Dim c As Double
Dim y As Integer
Dim x As Double
Dim i_m_very_tired As Double


'force entering the loop
y = 0




'loop
While y = 0 And x <= up


x = low


'formula


a = 3 * Application.WorksheetFunction.Power(x, 2)


b = 10 / Application.WorksheetFunction.Power(x, 2)


c = 2 * WorksheetFunction.Cosh(x)


i_m_very_tired = a - b - c


'condition if the answer is less than 0.001 and more than -0.01, exit the loop
If i_m_very_tired < 0.01 And i_m_very_tired > -0.01 Then


y = 1


'else, continue the loop with increasing x


Else


x = x + 0.01


End If


Wend


optima = x
​

 

[Eric W]

You have MULTIPLE issues with this code!

If i_m_very_tired < 0.01 And i_m_very_tired > -0.01 Then
y = 1

will never be true, and so will never exit the loop. You're obviously looking for an absolute difference from zero. Also i_m_very_tired is cute, but a horrible descriptive name. You also have unaccounted for division by zero.
Try this:

Function optima(low As Double, up As Double)

Dim a As Double, b As Double, c As Double
Dim x As Double
Dim i_m_very_tired As Double
Dim BestX As Double, BestY As Double, BestDif As Double, tolerance as Double

    BestX = 0
    BestY = 0
    BestDif = 9999999
    tolerance = .01
    On Error GoTo Oops:

    For x = low To up Step 0.01

        a = 3 * Application.WorksheetFunction.Power(x, 2)
        b = 10 / Application.WorksheetFunction.Power(x, 2)
        c = 2 * WorksheetFunction.Cosh(x)
        i_m_very_tired = a - b - c

        If Abs(i_m_very_tired) < BestDif Then
            BestX = x
            BestY = i_m_very_tired
            BestDif = Abs(BestY)
            If BestDif < tolerance Then Exit For
        End If
NextX:
    Next x

    optima = BestX
    Exit Function

Oops:
    Resume NextX:

End Function

Read it over until you understand what it's doing. I assume this is some kind of programming exercise, since the built-in Solver can do this for you.

Good luck!

 

[eddytan95]

Okay. Thanks Eric.

But, I can't really understand with this line of code which is

Oops:
Resume NextX:

which belongs to

On Error GoTo Oops:

And, yes, you are right, which i'm trying to learn VBA coding, and it's quite complicated compare to c and c++ programming :/

What i'm currently understand is,

'the code runs from here
Function optima(low As Double, up As Double)


Dim a As Double, b As Double, c As Double
Dim x As Double
Dim i_m_very_tired As Double
Dim BestX As Double, BestY As Double, BestDif As Double, tolerance As Double


    BestX = 0
    BestY = 0
    BestDif = 9999999
    tolerance = 0.00001
'can't understand what this is, google it, which tells me, whenever there is an error, it goes back to somewhere else
    On Error GoTo Oops:

'substitution of x = x + 0.01, looks really nice, thanks
    For x = low To up Step 0.00001


        a = 3 * Application.WorksheetFunction.Power(x, 2)
        b = 10 / Application.WorksheetFunction.Power(x, 2)
        c = 2 * WorksheetFunction.Cosh(x)
        i_m_very_tired = a - b - c

'substitution of While ff < 0.001 And ff > -0.001, which takes the absolute of the f(x), then comparing with the answer that i want, which is <0.001 and >-0.001, if it's an abs, >-0.001 is no need in here, thanks really, :) i learned something here.


        If Abs(i_m_very_tired) < BestDif Then
            BestX = x
            BestY = i_m_very_tired
            BestDif = Abs(BestY)
'now, it double checking my answer with tolerance
            If BestDif < tolerance Then Exit For
        End If

'exiting for loop
NextX:
    Next x


'executing answer in excel
    optima = BestX
    Exit Function


'i can't understand starting from here
Oops:
    Resume NextX:


End Function

Sorry for bothering your time , Eric

 

[mikerickson]

Perhaps something like this

Sub test()
    MsgBox FindRootBetween(-4, -1)
End Sub

Function FindRootBetween(Below As Double, Above As Double, Optional Precision As Double = 1e-09) As Double
    Dim IsDecreasing As Boolean
    Dim temp As Double
    Dim Mid As Double, midVal As Double
    
    IsDecreasing = SomeFunction(Above) < SomeFunction(Below)
    Mid = (Above + Below) / 2
    midVal = SomeFunction(Mid)
    
    If Precision < Abs(midVal) Then
        If (SomeFunction(Mid) < 0) Xor IsDecreasing Then
            FindRootBetween = FindRootBetween(Mid, Above, Precision)
        Else
            FindRootBetween = FindRootBetween(Below, Mid, Precision)
        End If
    Else
        FindRootBetween = Mid
    End If
End Function

Function SomeFunction(ByVal x As Double) As Double
    SomeFunction = (3 * x ^ 2) - (10 / (x ^ 2)) - (2 * WorksheetFunction.Cosh(x))
End Function

 

[Eric W]

No problem, I'm glad to help. That's why I answered. It's also nice to see that you're taking the time to figure it out. Some people just want the answers.

The part you're missing is pretty much unique to Visual Basic. A lot of statements can cause an error. For example, if x is 0, then the line starting with "b = " will evaluate to 10 / 0. Division by zero is bad , so VBA normally will just end there with an error message. But if you put an "On Error" statement, then you can write your own error handler. In this case, I named it Oops: And I don't do any real error handling. All I do is tell VBA to Resume in the main subroutine at label Nextx: I know x will be incremented, so the main loop will keep trying other values.

I'd guess that your function has an asymptote at zero.

Hope this helps!

 

[eddytan95]

Yeah....when x=0, there will be an asymptote,
So basically "Opps" is used when x=0 and instead of showing error at a particular column, it jumps back to nextx and executing out the answer right?

 

[Eric W]

You got it!