Kind regards,

Niek Otten
Microsoft MVP - Excel

     ' ===================================================================
     Function Backward(ValueToBeFound As Double, MoreArguments As Double, _
     Optional ReasonableGuess, Optional MaxNumberIters, _
     Optional MaxDiffPerc) As Double
     '
     ' Niek Otten, March 22 2006
     '
     ' 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 Long

     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
     ' ===================================================================

David