PDA

View Full Version : Solved: Excel Multiple Goal Seek Code.



hendra
01-22-2008, 10:31 PM
Hi,

I got the multiple goal seek macro from old post.
It works but the array data series should be in rows.
Could you please help me how to modify the code or just give me the macro so I can use it for array data series in columns.

Thanks so much.
Hendra

anandbohra
01-22-2008, 10:49 PM
Hi,

I got the multiple goal seek macro from old post.
It works but the array data series should be in rows.
Could you please help me how to modify the code or just give me the macro so I can use it for array data series in columns.

Thanks so much.
Hendra
pl paste the old post link or formula to do it in faster way.

hendra
01-22-2008, 11:09 PM
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
End Sub

anandbohra
01-22-2008, 11:27 PM
the macro is no where restricted user for selection in row or column.

I think u get confused because of input box default selection.

pl refer this attached file (code changed only in respect of default property of inputbox method made it from specified range to selection.address)

file is attached along with example

hendra
01-23-2008, 01:32 AM
I know it. Please try if you transpose all the data so your data will be in columns, and then run macro.


which cells to be change Set Cell Range Change to range 15 40 6
7 20 44 8.8
9 25 45 11.25
12 30 42 12.6
15 35 39 13.65
17 40 12 4.8
20

hendra
01-23-2008, 01:36 AM
which cells to be change Set Cell Range Change to range 15 40 6 7 20 44 8.8 9 25 45 11.25 12 30 42 12.6 15 35 39 13.65 17 40 12 4.8 20

hendra
01-23-2008, 01:38 AM
Sorry, I want to show you the table, but the format is not applicable.

anandbohra
01-23-2008, 02:00 AM
got your point
the modification required is in 4th last line

old line
For i = 1 To TargetVal.columns.Count

New line
For i = 1 To TargetVal.Rows.Count

hendra
01-23-2008, 02:59 AM
Thanks so much. I really appreciate it.