Goal Seek function

  • Thread starter Thread starter David
  • Start date Start date
Not directly.

But maybe you find the example function below of any use to you. It
goalseeks another function.
Copy the text of the function, start the VB Editor (ALT+F11), Insert>Module,
paste the module.
Post again if you have problems

--

Kind Regards,

Niek Otten

Microsoft MVP - Excel


' ===================================================================
Option Explicit

Function Backward(ValueToBeFound As Double, MoreArguments As Double, _
Optional ReasonableGuess, Optional MaxNumberIters, _
Optional MaxDiffPerc) As Double

' This example function goalseeks another function,
' called Forward. It works for almost any continuous function,
' although if that function has several maximum and/or minimum
' values, the value of the ReasonableGuess argument becomes
' important.
' It calculates the value for ReasonableGuess and for
' 1.2 * ReasonableGuess.
' It assumes that the function's graph is a straight line and
' extrapolates that line from these two values to find the value
' for the argument required to achieve ValueToBeFound.
' Of course that doesn't come out right, so it does it again for
' this new result and one of the other two results, depending on
' the required direction (greater or smaller).
' This process is repeated until the maximum number of calculations
' has been reached, in which case an errorvalue is returned,
' or until the value found is close enough, in which case
' the value of the most recently used argument is returned

Dim LowVar As Double, HighVar As Double, NowVar As Double
Dim LowResult As Double, HighResult As Double, NowResult As Double
Dim MaxDiff As Double
Dim NotReadyYet As Boolean
Dim IterCount As Integer

If IsMissing(ReasonableGuess) Then ReasonableGuess = 1.5 ' use default
values
If IsMissing(MaxNumberIters) Then MaxNumberIters = 20 ' that make
sense in the
If IsMissing(MaxDiffPerc) Then MaxDiffPerc = 0.001 ' context of the
function

MaxDiff = ValueToBeFound * MaxDiffPerc
NotReadyYet = True
IterCount = 1
LowVar = ReasonableGuess
LowResult = Forward(LowVar, MoreArguments)
HighVar = LowVar * 1.2
HighResult = Forward(HighVar, MoreArguments)

While NotReadyYet
IterCount = IterCount + 1
If IterCount > MaxNumberIters Then
Backward = CVErr(xlErrValue) 'or some other
errorvalue
Exit Function
End If
NowVar = ((ValueToBeFound - LowResult) * (HighVar - LowVar) + LowVar _
* (HighResult - LowResult)) / (HighResult - LowResult)

NowResult = Forward(NowVar, MoreArguments)

If NowResult > ValueToBeFound Then
HighVar = NowVar
HighResult = NowResult
Else
LowVar = NowVar
LowResult = NowResult
End If

If Abs(NowResult - ValueToBeFound) < MaxDiff Then NotReadyYet = False
Wend
Backward = NowVar
End Function

Function Forward(a As Double, b As Double) As Double
' This is just an example function;
' almost any continous function will work
Forward = 3 * a ^ (1.5) + b
End Function
' ===================================================================
 
Back
Top