# VBA to solve for equation based on missing variable

#### mpfanalytics

##### New Member
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

##### MrExcel MVP
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.
Code:
``````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.

Code:
``````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

##### Board Regular
Try this macro
Code:
``````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``````

Last edited: