VBA to solve for equation based on missing variable

[mpfanalytics]

Hi all, first post here.

I've been learning VBA, and I've found the best way for me is to jump into exercises I've never done before. I recently came across a problem and decided to take a shot at it. I'm trying to use VBA to solve for the equation A = (B/C)^D, where any one variable A, B, C, or D is missing, and the others are constants pulled from cells. Ideally I'd like to create a msg box where you can input a value for each variable and it'll solve for the missing variable, but baby steps lol. Any help would be appreciated! I have attached images below of what I've done so far.

[/IMG]

[/IMG]

 

[mikerickson]

To find numeric solutions to formulas, it helps to put all the variables on one side of the equation.
Instead of A = (B-C)^D, use ((B-C)^D) - A = 0.
This algebra is best done by the user. VBA (or any programming language) doing algebra is nasty.

If you know 3 of the variables, this becomes a function of one variable. In your example it becomes (4800-750)^2 - A.

One way that I like to solve for zeros of an equation is to use the binary search method.

Sub test()
    MsgBox FindZeroBetween(-50000000, 50000000)
End Sub

Function FindZeroBetween(startLow As Double, startHigh As Double, Optional Accuracy As Double = 1e-06) As Double
    Dim Low As Double, High As Double, Mid As Double
    
    Rem clean arguments
    Accuracy = Abs(Accuracy)
    If Accuracy = 0 Then Accuracy = 1e-06
    If MyFunction(startLow) < MyFunction(startHigh) Then
        Low = startLow
        High = startHigh
    Else
        Low = startHigh
        High = startLow
    End If
    Rem check
    Select Case Sgn(MyFunction(Low) * MyFunction(High))
        Case Is = 1
        Rem both have same sign, aborth
            MsgBox "start values do not capture zero"
            Exit Function
        Case Is = 0
            Rem one of the startvalues is a zero
            If MyFunction(Low) = 0 Then
                Mid = Low
            Else
                Mid = High
            End If
            MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
            FindZeroBetween = Mid
            Exit Function
        Case Else
            Rem all is good
    End Select
    
    Rem binary search
    Do
        Mid = (High + Low) / 2
        Select Case MyFunction(Mid)
            Case Is < (-1 * Accuracy)
                Rem mid becomes low
                Low = Mid
            Case Is > Accuracy
                Rem mid becomes high
                High = Mid
            Case Else
                Rem we have a solution
                Exit Do
        End Select
    Loop Until False
    
    MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
    
    FindZeroBetween = Mid
End Function

Function MyFunction(x As Double) As Double
    MyFunction = ((4800 - 750) ^ 2) - x
End Function

Note that the FindZeroBetween needs two values a and b where F(a) is positive and F(b) is negative.
Note also that binary search is limited to "nice" functions. Continous is the primary requirement, there's a whold body of literature on the limits of binary search.
Note also that because of the way that computers store numbers, its best to look for ABS(F(x)) < delta rather then F(x)=0. Hence the Accuracy variable.

If the function is "nice" enough, Excel can search for and find suitable start points for FindZeroBetween.

Sub test()
    MsgBox FindZero
End Sub

Function FindZero() As Double
    Dim EndPoint As Double
    EndPoint = 1
    Do While True
        If Sgn(MyFunction(EndPoint) * MyFunction(-1 * EndPoint)) = -1 Then
            Rem good to go
            Exit Do
        Else
            EndPoint = 2 * EndPoint
        End If
    Loop
    FindZero = FindZeroBetween(EndPoint, -1 * EndPoint)
End Function

Function FindZeroBetween(startLow As Double, startHigh As Double, Optional Accuracy As Double = 1e-06) As Double
    Dim Low As Double, High As Double, Mid As Double
    
    Rem clean arguments
    Accuracy = Abs(Accuracy)
    If Accuracy = 0 Then Accuracy = 1e-06
    If MyFunction(startLow) < MyFunction(startHigh) Then
        Low = startLow
        High = startHigh
    Else
        Low = startHigh
        High = startLow
    End If
    Rem check
    Select Case Sgn(MyFunction(Low) * MyFunction(High))
        Case Is = 1
        Rem both have same sign, aborth
            MsgBox "start values do not capture zero"
            Exit Function
        Case Is = 0
            Rem one of the startvalues is a zero
            If MyFunction(Low) = 0 Then
                Mid = Low
            Else
                Mid = High
            End If
            MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
            FindZeroBetween = Mid
            Exit Function
        Case Else
            Rem all is good
    End Select
    
    Rem binary search
    Do
        Mid = (High + Low) / 2
        Select Case MyFunction(Mid)
            Case Is < (-1 * Accuracy)
                Rem mid becomes low
                Low = Mid
            Case Is > Accuracy
                Rem mid becomes high
                High = Mid
            Case Else
                Rem we have a solution
                Exit Do
        End Select
    Loop Until False
    
    MsgBox "MyFunction(" & Mid & ") = " & MyFunction(Mid)
    
    FindZeroBetween = Mid
End Function

Function MyFunction(x As Double) As Double
    MyFunction = ((4800 - 750) ^ 2) - x
End Function

 

[salim hasan]

Try this macro

Option Explicit
Sub SOLVE_mY_EQ()
Dim  b, c, d
b = Cells(5, 3)
c = IIf(Cells(6, 3) = "" Or Not IsNumeric(Cells(6, 3)) _
    Or Cells(6, 3) = 0, 1, Cells(6, 3))
    Cells(6, 3)=c
d = Cells(7, 3)


Cells(4, 3) = (b / c) ^ d
' Or To Round To 2 digits
'Cells(4, 3) = Round((b / c) ^ d, 2)
End Sub