Sure, This code in fact assign the kchange and vchange for variables and make the obj function to zero. Please see Sub Opter
Sub starter()
'Application.ScreenUpdating = False
donum = -15
mini = 10
off = 57
con = 0
SelNum = -57
Sheets("Solver").Select
Range("B66").Select
Call ValSet
Call Opter
Range("B17").Select
Call valOf
Range("B66").Select
Call Opter
Range("B66").Select
con = 1
kchange = -0.5
vchange = 0.5
Call Opter
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 1
vchange = 1
Call Opter
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 0.5
vchange = -0.5
Call Opter
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = -0.5
vchange = -0.5
Call Opter
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 0.5
vchange = 0.5
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = -0.5
vchange = 0.5
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 0.5
vchange = -0.5
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 10
vchange = 1
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 5
vchange = 1
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 1
vchange = 5
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 2
vchange = 50
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = -5
vchange = 0.5
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = -10
vchange = 10
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = -10
vchange = 1
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = 1
vchange = 10
Call OpterUnconst
Range("B17").Select
'Call valOf
Range("B66").Select
kchange = -0.5
vchange = -0.5
Call OpterUnconst
Range("B17").Select
'Call valOf
con = 0
Range("N66").Select
Call Opter
Range("N66").Select
con = 1
kchange = 1
vchange = 1
Call Opter
Range("N66").Select
'con = 1
kchange = 0.123
vchange = 0.321
Call Opter
Range("N66").Select
kchange = -0.5
vchange = 0.5
Call Opter
Range("N66").Select
kchange = 0.5
vchange = -0.5
Call Opter
Range("N66").Select
kchange = -0.5
vchange = -0.5
Call Opter
Range("N66").Select
kchange = 0.5
vchange = 0.5
Call OpterUnconst
Range("N66").Select
kchange = -0.5
vchange = 0.5
Call OpterUnconst
Range("N66").Select
kchange = 0.5
vchange = -0.5
Call OpterUnconst
Range("N66").Select
kchange = 5
vchange = 1
Call OpterUnconst
Range("N66").Select
kchange = 1
vchange = 5
Call OpterUnconst
Range("N66").Select
kchange = -0.5
vchange = -0.5
Call OpterUnconst
Range("AB66").Select
con = 0
Call Opter3
Range("AB66").Select
con = 1
kchange = -3
Call Opter3
Range("AK66").Select
Call Opter4
con = 0
mini = 1
donum = 2
off = 3
Range("BB15").Select
Call valOf2
Range("BP15").Select
Call valOf2
Range("AV24").Select
Call OpterUnconstr
Range("AV12").Select
Call OpterUnconstr
Range("BJ24").Select
Call OpterUnconstr
Range("BJ12").Select
Call OpterUnconstr
con = 0
mini = 0
donum = -2
off = 49
SelNum = -49
Range("BP54").Select
Call OpterUnconstr
Range("BB54").Select
Call OpterUnconstr
SolverReset
End Sub
Sub ValSet()
'Application.ScreenUpdating = False
Range("B9:J10, AB9:AH9").Value = 0.5
Range("N9:O10, Q9:U10, W9:W10, X10").Value = -0.5
Range("P9").Value = 2
Range("P10").Value = -2.5
Range("AK9:AP9").Value = 0.75
Range("V9").Value = -0.005
Range("v10").Value = 0.05
Range("x9").Value = -0.05
End Sub
Sub Opter()
'Application.ScreenUpdating = False
'Call Module1.Iterations
'Print ActiveCell.Address
Do While IsEmpty(ActiveCell.Offset(donum, 0)) = False
If mini = 1 Then
Call selecterMini
Else
Call selecter
End If
Set changev = Selection
ActiveCell.Offset(off, 0).Select
Debug.Print ActiveCell.Address
On Error GoTo erhand
If ActiveCell.Value > 950 Then
If con = 1 Then
Range(kvar).Value = kchange
Range(vVar).Value = vchange
Else
End If
'Application.Run "SolverReset"
'Application.Run "SolverOk", "ActiveCell.Address", 3, "0", "changev.Address"
'Application.Run "SolverAdd", "kvar", 1, "Range(kvar).Offset(-1, 0).value"
'Application.Run "SolverAdd", "kvar", 3, "Range(kvar).Offset(-2, 0).value"
'Application.Run "SolverAdd", "vvar", 1, "Range(vVar).Offset(-4, 0).value"
'Application.Run "SolverAdd", "vvar", 3, "Range(vVar).Offset(-5, 0).value"
'Application.Run "SolverSolve", True
SolverReset
SolverOptions AssumeNonNeg:=False, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=changev.Address
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value
SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).Value
SolverAdd CellRef:=vVar, Relation:=3, FormulaText:=Range(vVar).Offset(-5, 0).Value
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub valOf()
'Application.ScreenUpdating = False
Do While IsEmpty(ActiveCell.Offset(-2, 0)) = False
If ActiveCell.Value = "Run Opt.1" Then
SolverReset
SolverOk SetCell:=ActiveCell.Offset(1, 0).Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=Selection.Offset(2, 0).Address
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop
End Sub
Sub valOf2()
'Application.ScreenUpdating = False
Do While IsEmpty(ActiveCell.Offset(-3, 0)) = False
If ActiveCell.Value = "Run Opt.1" Then
SolverReset
SolverOk SetCell:=ActiveCell.Offset(1, 0).Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=Selection.Offset(2, 0).Address
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
ActiveCell.Offset(0, 1).Select
End If
Loop
End Sub
Sub OpterUnconst()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(donum, 0)) = False
If mini = 1 Then
Call selecterMini
Else
Call selecter
End If
Set changev = Selection
ActiveCell.Offset(off, 0).Select
On Error GoTo erhand
If ActiveCell.Value > 950 Or ActiveCell < -500 Then
If con = 1 Then
Range(kvar).Value = kchange
Range(vVar).Value = vchange
Else
End If
SolverReset
SolverOptions AssumeNonNeg:=False, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=changev.Address
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value + 2
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value - 2
SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).Value + 15
SolverAdd CellRef:=vVar, Relation:=3, FormulaText:=Range(vVar).Offset(-5, 0).Value - 15
'SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).value
'SolverAdd CellRef:=kvar, Relation:=3, FormulaText:="0.0001"
'SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).value
'SolverAdd CellRef:=vVar, Relation:=3, FormulaText:="0.0001"
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub OpterUnconstr()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(donum, 0)) = False
If mini = 1 Then
Call selecterMini
Else
Call selecter
End If
Set changev = Selection
ActiveCell.Offset(off, 0).Select
On Error GoTo erhand
If ActiveCell.Value > 0.95 Or ActiveCell < -0.5 Then
If con = 1 Then
Range(kvar).Value = kchange
Range(vVar).Value = vchange
Else
End If
SolverReset
SolverOptions AssumeNonNeg:=False, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=changev.Address
'SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).value + 2
'SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).value - 2
'SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).value + 15
'SolverAdd CellRef:=vVar, Relation:=3, FormulaText:=Range(vVar).Offset(-5, 0).value - 15
'SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).value
'SolverAdd CellRef:=kvar, Relation:=3, FormulaText:="0.0001"
'SolverAdd CellRef:=vVar, Relation:=1, FormulaText:=Range(vVar).Offset(-4, 0).value
'SolverAdd CellRef:=vVar, Relation:=3, FormulaText:="0.0001"
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Opter3()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(-10, 0)) = False
Call selecter3
Set changev = Selection
ActiveCell.Offset(57, 0).Select
On Error GoTo erhand
If ActiveCell.Value > 950 Or ActiveCell.Value < -0.1 Then
'MsgBox ActiveCell.value
If con = 1 Then
Range(kvar).Value = kchange
Else
End If
SolverReset
SolverOptions AssumeNonNeg:=True, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=3, _
ValueOf:=0, _
ByChange:=kvar
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
Else
erhand:
Resume Next
ActiveCell.Offset(0, 1).Select
End If
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Opter4()
'Application.ScreenUpdating = False
'Call Module1.Iterations
Do While IsEmpty(ActiveCell.Offset(-13, 0)) = False
Call selecter3
Set changev = Selection
ActiveCell.Offset(57, 0).Select
SolverReset
SolverOptions AssumeNonNeg:=True, Derivatives:=2
SolverOk SetCell:=ActiveCell.Address, _
MaxMinVal:=2, _
ByChange:=kvar
SolverAdd CellRef:=kvar, Relation:=1, FormulaText:=Range(kvar).Offset(-1, 0).Value
SolverAdd CellRef:=kvar, Relation:=3, FormulaText:=Range(kvar).Offset(-2, 0).Value
SolverSolve UserFinish:=True
ActiveCell.Offset(0, 1).Select
'erhand:
'Resume Next
'ActiveCell.Offset(0, 1).Select
Loop
'Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub selecter()
'Application.ScreenUpdating = False
ActiveCell.Offset(SelNum, 0).Select
kvar = ActiveCell.Address
ActiveCell.Offset(1, 0).Select
vVar = ActiveCell.Address
ActiveCell.Offset(-1, 0).Select
ActiveCell.Resize(2).Select
End Sub
Sub selecter3()
'Application.ScreenUpdating = False
ActiveCell.Offset(-57, 0).Select
kvar = ActiveCell.Address
End Sub
Sub selecterMini()
ActiveCell.Offset(-3, 0).Select
kvar = ActiveCell.Address
ActiveCell.Offset(1, 0).Select
vVar = ActiveCell.Address
ActiveCell.Offset(-1, 0).Select
ActiveCell.Resize(2).Select
End Sub
Sub it2()
'Range("B9:J10").value = 0.5
'MsgBox kvar & " " & vVar
'MsgBox Range(kvar).Offset(-2, 0).value
Application.Run "SolverReset"
Application.Run "SolverOk", "ActiveCell.Address", 3, "0", "changev.Address"
Application.Run "SolverAdd", "kvar", 1, "Range(kvar).Offset(-1, 0).value"
Application.Run "SolverAdd", "kvar", 3, "Range(kvar).Offset(-2, 0).value"
Application.Run "SolverAdd", "vvar", 1, "Range(vVar).Offset(-4, 0).value"
Application.Run "SolverAdd", "vvar", 3, "Range(vVar).Offset(-5, 0).value"
Application.Run "SolverSolve", True
End Sub