VBA to run Multiple Goal Seek Loop?
Hey guys, I found this post that I think will help me tremendously. What I am trying to do(with your help of course) is create a macro that I can run to goal seek numerous ranges all at once rather than having to go to the tools menu each and every time.
Let's begin:
The values in columns Q,S,U, and W reflect an increase or decrease based upon the previous period plus the percentage increase or decrease in the respective row for columns Y ,Z, AA, and AB.
AD,AE,AF, and AG are given values which I would like to goal seek using the formulas in Q,S,U, and W by changing cells Y, Z, AA, and AB. (note:AA, AB, AF, and AG not shown for character limits).
Thoughts?
What about a dialog box for selction purposes too?
Also, here is some code that I found from a gentlemen in Australia that I think might be on the right track, but I can't get it to run in my workbook. It keeps kicking me to the Debug, and unfortunately, I'm not sure if this is even close to what I am looking for. I think so, but am unsure
Hey guys, I found this post that I think will help me tremendously. What I am trying to do(with your help of course) is create a macro that I can run to goal seek numerous ranges all at once rather than having to go to the tools menu each and every time.
Let's begin:
The values in columns Q,S,U, and W reflect an increase or decrease based upon the previous period plus the percentage increase or decrease in the respective row for columns Y ,Z, AA, and AB.
AD,AE,AF, and AG are given values which I would like to goal seek using the formulas in Q,S,U, and W by changing cells Y, Z, AA, and AB. (note:AA, AB, AF, and AG not shown for character limits).
Thoughts?
What about a dialog box for selction purposes too?
CoPrep V.23 Multiple Goal Seek.xls | |||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
Q | R | S | T | U | V | W | X | Y | Z | AA | AB | AC | AD | AE | |||
7 | Forecast | Factor | Actual | ||||||||||||||
8 | 2007 | (12) | 2008 | (12) | 2009 | (12) | 2010 | (12) | 2007 | 2008 | 2007 | 2008 | |||||
9 | $1,770 | 100.0% | $1,929 | 100.0% | $2,025 | 100.0% | $2,127 | 100.0% | 3.8% | 9.0% | 1770 | 1929 | |||||
10 | $608 | 34.4% | $1,003 | 52.0% | $1,053 | 52.0% | $1,106 | 52.0% | 34.4% | 52.0% | 608 | 625 | |||||
11 | $1,162 | 65.6% | $926 | 48.0% | $972 | 48.0% | $1,021 | 48.0% | |||||||||
12 | |||||||||||||||||
13 | $478 | 27.0% | $521 | 27.0% | $547 | 27.0% | $574 | 27.0% | 27.0% | 27.0% | 758 | 782 | |||||
14 | $23 | 1.3% | $25 | 1.3% | $27 | 1.3% | $29 | 1.4% | 8.0% | 8.0% | 45 | 48 | |||||
15 | ($12) | -0.7% | ($14) | -0.7% | ($14) | -0.7% | ($15) | -0.7% | -0.7% | -0.7% | 0 | 118 | |||||
16 | $673 | 38.0% | $393 | 20.4% | $412 | 20.4% | $432 | 20.3% | |||||||||
Model |
Also, here is some code that I found from a gentlemen in Australia that I think might be on the right track, but I can't get it to run in my workbook. It keeps kicking me to the Debug, and unfortunately, I'm not sure if this is even close to what I am looking for. I think so, but am unsure
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
End Sub