Multiple Cell Goal Seek problems...

MyHero

New Member
Joined
Jan 22, 2009
Messages
26
I need to use a Multiple Cell Goal Seek.

I used the code from this site.

Here is the code:


Option Explicit
Sub Multi_Goal_Seek()
Dim TargetVal As Range, DesiredVal As Range, ChangeVal As Range, CVcheck As Range
Dim CheckLen As Long, i As Long

restart:
With Application
Set TargetVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select your range which contains the ""Set Cell"" range", Default:=Range("C11:E11").Address, Type:=8)
'no default option
'prompt:="Select your range which contains the ""Set Cell"" range",, Type:=8)
Set DesiredVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select the range which the ""Set Cells"" will be changed to", Default:=Range("C12:E12").Address, Type:=8)
'no default option
'prompt:="Select the range which the ""Set Cells"" will be changed to",, Type:=8)
Set ChangeVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select the range of cells that will be changed", Default:=Range("G8:G10").Address, Type:=8)
'no default option
'prompt:="Select the range of cells that will be changed",, Type:=8)
End With

'Ensure that the changing cell range contains only values, no formulas allowed
Set CVcheck = Intersect(ChangeVal, Union(Sheets(ChangeVal.Parent.Name).Cells.SpecialCells(xlBlanks), Sheets(ChangeVal.Parent.Name).Cells.SpecialCells(xlConstants)))
If CVcheck Is Nothing Then
MsgBox "Changing value range contains no blank cells or values" & vbNewLine & _
"Goal seek only works if the cells to be changed are values, please ensure that this is the case", vbCritical
Application.Goto reference:=DesiredVal
Exit Sub
Else

If CVcheck.Cells.Count <> DesiredVal.Cells.Count Then
MsgBox "Changing value range contains formulas" & vbNewLine & _
"Goal seek only works if the cells to be changed are values, please ensure that this is the case", vbCritical
Application.Goto reference:=DesiredVal
Exit Sub
End If
End If

'Ensure that the amount of cells is consistent
If TargetVal.Cells.Count <> DesiredVal.Cells.Count Or TargetVal.Cells.Count <> ChangeVal.Cells.Count Then
CheckLen = MsgBox("Ranges were different lengths, please press yes to re-enter", vbYesNo + vbCritical)
If CheckLen = vbYes Then
'If ranges are different sizes and user wants to redo then restart code
Goto restart
Else
Exit Sub
End If
End If

' Loop through the goalseek method
For i = 1 To TargetVal.Columns.Count
TargetVal.Cells(i).GoalSeek Goal:=DesiredVal.Cells(i).Value, ChangingCell:=ChangeVal.Cells(i)
Next i



Whenever I use the above code, Excel returns this error:

multiplegoalseekerrortq4.jpg


Here is an example spreadsheet.


Please help.
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
I should note that I've attempted to use the solver, but it said it was too complicated, for the spreadsheet I'm working on.

If anyone can improve the code to fix my problem, it would be wonderful!
 
Upvote 0
As the error message indicates, the cells that you specify as "change cells" (the 3rd InputBox) cannot contain a formula. You will have to reexamine your worksheet to figure out how it should actually work.

You may want to take a few minutes and run a few GoalSeek solutions by hand. That should help you understand how it works, what it expects, and how you should use it to your benefit.
 
Upvote 0
As the error message indicates, the cells that you specify as "change cells" (the 3rd InputBox) cannot contain a formula. You will have to reexamine your worksheet to figure out how it should actually work.

You may want to take a few minutes and run a few GoalSeek solutions by hand. That should help you understand how it works, what it expects, and how you should use it to your benefit.

In my example, the change cells are values, yet I receive this error.
 
Upvote 0
Okay,

I discovered the solution on my own.

The number of cells that can be changed has to EQUAL THE AMOUNT OF SET CELLS.

In my example:
Change these cells had 2 cells
To these values had 2 cells
By changing these cells had 1 cell.


Change these cells... To these values.. By changing these cells...
4 1 4
8 2

All I needed to do was change the third pronpt to include both cells underneath By changing these cells

Can anyone change the script so it can be less or more than the the number of cells in the third prompt doesn't have to equal the number of cells in the first two?

Thanks.
 
Upvote 0
The below code works fine for your requirement :

Option Explicit
Sub Multi_Goal_Seek()
Dim TargetVal As Range, DesiredVal As Range, ChangeVal As Range, CVcheck As Range
Dim CheckLen As Long, i As Long
restart:
With Application
Set TargetVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select your range which contains the ""Set Cell"" range", Default:=Range("B6:E6").Address, Type:=8)
'no default option
'prompt:="Select your range which contains the ""Set Cell"" range",, Type:=8)
Set DesiredVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select the range which the ""Set Cells"" will be changed to", Default:=Range("B8:E8").Address, Type:=8)
'no default option
'prompt:="Select the range which the ""Set Cells"" will be changed to",, Type:=8)
Set ChangeVal = .InputBox(Title:="Select a range in a single row or column", _
prompt:="Select the range of cells that will be changed", Default:=Range("B4:E4").Address, Type:=8)
'no default option
'prompt:="Select the range of cells that will be changed",, Type:=8)
End With

'Ensure that the changing cell range contains only values, no formulas allowed
Set CVcheck = Intersect(ChangeVal, Union(Sheets(ChangeVal.Parent.Name).Cells.SpecialCells(xlBlanks), Sheets(ChangeVal.Parent.Name).Cells.SpecialCells(xlConstants)))
If CVcheck Is Nothing Then
MsgBox "Changing value range contains no blank cells or values" & vbNewLine & _
"Goal seek only works if the cells to be changed are values, please ensure that this is the case", vbCritical
Application.Goto reference:=DesiredVal
Exit Sub
Else
End If

' Loop through the goalseek method
For i = 1 To TargetVal.Columns.Count
TargetVal.Cells(i).GoalSeek Goal:=DesiredVal.Cells(i).Value, ChangingCell:=ChangeVal.Cells(i)
Next i
End Sub
 
Upvote 0
Thanks Sanjeev.

This is better, but it's changing cells that shouldn't be changed. Please help.
 
Upvote 0

Forum statistics

Threads
1,213,554
Messages
6,114,280
Members
448,562
Latest member
Flashbond

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top