Automatic Goal Seek That References Cell For Target Value

I am trying to create a VBA code that does two things: automatically runs goal seek to update as inputs change, and references a cell containing a formula for the target value.

I want to:

Set cell I24
To the value that is shown in cell G9 (which contains a formula, and the value in the cell will change as other inputs change)
By changing cell F24

Any help on a VBA code that would accomplish this?

Thank you!

Welcome to the forum!

If you can attach a file and show what your manual run's results were, we can then work on the automation. To attach a file, click the Go Advanced button in lower right of a reply. Click the paperclip icon in the toolbar and Browse and Upload the file.

Goalseek and solver can be similar. See these examples and links to get you going. Once the file is added, code can be added to run a routine if the cell I24 is changed.

'http://support.microsoft.com/en-us/kb/843304
' http://www.solver.com/content/basic-solver-solversolve-function


Sub Create_Square_Root_Table()

    ' Add a new worksheet to the workbook.
    Set w = Worksheets.Add

    ' Put the value 2 in cell C1 and the formula =C1^2 in cell C2.
    w.Range("C1").Value = 2
    w.Range("C2").Formula = "=C1^2"

    ' A loop that will make 10 iterations, starting with the number 1,
    ' and finishing at the number 10.
    For i = 1 To 10

        ' Set the Solver parameters that indicate that Solver should
        ' solve the cell C2 for the value of i (where i is the number
        ' of the iteration) by changing cell C1.
        SolverOK SetCell:=Range("C2"), ByChange:=Range("C1"), _
            MaxMinVal:=3, ValueOf:=i

        ' Do not display the Solver Results dialog box.
        SolverSolve UserFinish:=True

        ' Save the value of i in column A and the results of the
        ' changing cell in column B.
        w.Cells(i, 1) = i
        w.Cells(i, 2) = Range("C1")

        ' Finish and discard the final results.
        SolverFinish KeepFinal:=2

    Next

End Sub


Sub sken()
  SolverOK SetCell:=Range("CF21"), ByChange:=Range("CE21"), _
      MaxMinVal:=0, ValueOf:=0

'SolverOk SetCell:="$X$14", MaxMinVal:=3, ValueOf:=1, ByChange:="$X$12", Engine _
        :=1, EngineDesc:="GRG Nonlinear"
'    SolverSolve userfinish:=True

  ' Do not display the Solver Results dialog box.
 ' SolverSolve UserFinish:=False


  ' Finish and discard the final results.
  'SolverFinish KeepFinal:=2
End Sub


Sub test_Goalseek()
  Range("CE21").Value = 0
  Debug.Print "Run1 at 0", GoalSeek(Range("CF21"), 0, Range("CE21"))
  Range("CE21").Value = 1000
  Debug.Print "Run1 at 1,000", GoalSeek(Range("CF21"), 0, Range("CE21"))
  
  Range("CE21").Value = 0
  Debug.Print "Run2 at 0", GoalSeek(Range("CG21"), 0, Range("CE21"))
  Range("CE21").Value = 1000
  Debug.Print "Run2 at 1,000", GoalSeek(Range("CG21"), 0, Range("CE21"))
  
  Range("CE21").Value = 0
  Debug.Print "Run2 at 0", GoalSeek(Range("CH21"), 0, Range("CE21"))
  Range("CE21").Value = 1000
  Debug.Print "Run2 at 1,000", GoalSeek(Range("CH21"), 0, Range("CE21"))
  
  Range("CE21").Value = 0
  Debug.Print "Run2 at 0", GoalSeek(Range("CI21"), 0, Range("CE21"))
  Range("CE21").Value = 1000
  Debug.Print "Run2 at 1,000", GoalSeek(Range("CI21"), 0, Range("CE21"))
  
  Range("CE21").Value = 0
  Debug.Print "Run2 at 0", GoalSeek(Range("CJ21"), 0, Range("CE21"))
  Range("CE21").Value = 1000
  Debug.Print "Run2 at 1,000", GoalSeek(Range("CJ21"), 0, Range("CE21"))
  
  '=LINEST(BA3:BA189,AT3:AT189^{1,2,3,4,5,6}) 'i=6 degree fit
  Range("CE21").Value = 0
  Debug.Print "Run2 at -2.24291098117828 rut, 0 initial", GoalSeek(Range("CJ21"), -2.24291098117828, Range("CE21"))
  Range("CE21").Value = 1000
  Debug.Print "Run2 at -2.24291098117828 rut, 1,000 initial", GoalSeek(Range("CJ21"), -2.24291098117828, Range("CE21"))
End Sub

Function GoalSeek(formulaCell As Range, dGoal As Double, rChangingCell As Range) As Double
  Application.Volatile True
  'On Error Resume Next
  formulaCell.GoalSeek Goal:=dGoal, ChangingCell:=rChangingCell
  GoalSeek = rChangingCell.Value
  
  'If rChangingCell=0 it shows 1228.71, 1000 shows 1122.5
  'OKSolver below shows 1119.8 for both 0 and 1000 rChangingCell initial values
End Function


Sub OKSOlver()
    SolverOK SetCell:="$CF$21", MaxMinVal:=20000, ValueOf:=0, ByChange:="$CE$21", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverSolve True, "ShowTrial"
End Sub

'https://msdn.microsoft.com/en-us/library/office/ff197237.aspx?f=255&MSPPError=-2147217396
Sub MSDN()
  Worksheets("Sheet1").Activate
  SolverReset
  SolverOptions Precision:=0.001
  SolverOK SetCell:=Range("TotalProfit"), _
      MaxMinVal:=1, _
      ByChange:=Range("C4:E6")
  SolverAdd CellRef:=Range("F4:F6"), _
      Relation:=1, _
      FormulaText:=100
  SolverAdd CellRef:=Range("C4:E6"), _
      Relation:=3, _
      FormulaText:=0
  SolverAdd CellRef:=Range("C4:E6"), _
      Relation:=4
  SolverSolve UserFinish:=False, ShowRef:="ShowTrial"
  SolverSave SaveArea:=Range("A33")
End Sub

 
Function ShowTrial(Reason As Integer)
  MsgBox Reason
  ShowTrial = 0
End Function

To run GoalSeek automatically you could probably use the Private sub Worksheet_Change event. But as you seem to wish that GoalSeek should run when the value in G9 changes and as G9 contains a formula this requires a somewhat different approach. I think doing it this way should work.

Start by right clicking the tab on sheet1 and select “View code”

To the left you see under “Microsoft Excel Objects” an number of sheets and “ThisWorkbook”

Right click on “ThisWorkbook” and click “View Code”. In the windows that opens paste this code

Private Sub Workbook_Open()
	PreVal = Sheet1.Range(“G9”).Value
End Sub

Then right click on Sheet1 and click “View Code”. In this window you paste this code

Private Sub Worksheet_Calculate()
     If Range(“G9.Value <> PreVal Then
       Range("I24").GoalSeek Goal:=Range("G9").Value, ChangingCell:=Range("F24")
End If
End Sub

Save the workbook, close it. Open it again an make a change that should give you a changed value in G9 and see if GoalSeek fires.

Alf

Sub Test_GoalSeek()
  ' 8.14%, 6.85%, 10.00
  ' Range("I24").GoalSeek Goal:=Range("G9").Value, ChangingCell:=Range("F24")
  GoalSeek [I24], [G9], [F24]
  '6.85, 6.85, 166.75
End Sub

Function GoalSeek(formulaCell As Range, dGoal As Double, rChangingCell As Range) As Double
  Application.Volatile True
  'On Error Resume Next
  formulaCell.GoalSeek Goal:=dGoal, ChangingCell:=rChangingCell
  GoalSeek = rChangingCell.Value
End Function

I have a similar problem to what has been discussed here. I am trying to automate one way or another the Goal Seek function in a spreadsheet such that it can either bur run by a macro or when an entry has been changed. I tried to run as a macro but the goal seek value seems like it needs to be hard coded and cannot reference a cell or be copied into the dialogue box. Any help would be greatly appreciated. TIA

Hi

Welcome to the forum but ........

I have a similar problem to what has been discussed here.

as forum rule #2 says that

Don't post a question in the thread of another member -- start your own. If you feel it's particularly relevant, provide a link to the other thread. You may include up to 3 links to other URLs in a single post, no more, so only link to the relevant pages.

So start a thread on your own and most likely a member will help you. And by the way a "new" thread attracts more attention then an "old" with several postings.

Alf