VBA to run Multiple Goal Seek Loop?

[McGu]

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?

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

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

 

[McGu]

Bump and Revised

BUMP and revised:

I have recorded a macro that runs through each line that I have and performs a goal seek to back into the number using the formula in the respective cell. Can it be improved?

Sub Macro2()
'
' Macro2 Macro
' Macro recorded 12/5/2006
'

'Revenue
    Range("Q9").Select
    Range("Q9").GoalSeek Goal:=Range("AD9"), ChangingCell:=Range("Y9")
    Range("S9").Select
    Range("S9").GoalSeek Goal:=Range("AE9"), ChangingCell:=Range("Z9")
    Range("U9").Select
    Range("U9").GoalSeek Goal:=Range("AF9"), ChangingCell:=Range("AA9")
    Range("W9").Select
    Range("W9").GoalSeek Goal:=Range("AG9"), ChangingCell:=Range("AB9")

'Cost of Sales
    Range("Q10").Select
    Range("Q10").GoalSeek Goal:=Range("AD10"), ChangingCell:=Range("Y10")
    Range("S10").Select
    Range("S10").GoalSeek Goal:=Range("AE10"), ChangingCell:=Range("Z10")
    Range("U10").Select
    Range("U10").GoalSeek Goal:=Range("AF10"), ChangingCell:=Range("AA10")
    Range("W10").Select
    Range("W10").GoalSeek Goal:=Range("AG10"), ChangingCell:=Range("AB10")

'Selling General & Admin Expense
    Range("Q13").Select
    Range("Q13").GoalSeek Goal:=Range("AD13"), ChangingCell:=Range("Y13")
    Range("S13").Select
    Range("S13").GoalSeek Goal:=Range("AE13"), ChangingCell:=Range("Z13")
    Range("U13").Select
    Range("U13").GoalSeek Goal:=Range("AF13"), ChangingCell:=Range("AA13")
    Range("W13").Select
    Range("W13").GoalSeek Goal:=Range("AG13"), ChangingCell:=Range("AB13")

'Depreciation and Amortization
    Range("Q14").Select
    Range("Q14").GoalSeek Goal:=Range("AD14"), ChangingCell:=Range("Y14")
    Range("S14").Select
    Range("S14").GoalSeek Goal:=Range("AE14"), ChangingCell:=Range("Z14")
    Range("U14").Select
    Range("U14").GoalSeek Goal:=Range("AF14"), ChangingCell:=Range("AA14")
    Range("W14").Select
    Range("W14").GoalSeek Goal:=Range("AG14"), ChangingCell:=Range("AB14")
    
  'Other (Income)/Expense
    Range("Q15").Select
    Range("Q15").GoalSeek Goal:=Range("AD15"), ChangingCell:=Range("Y15")
    Range("S15").Select
    Range("S15").GoalSeek Goal:=Range("AE15"), ChangingCell:=Range("Z15")
    Range("U15").Select
    Range("U15").GoalSeek Goal:=Range("AF15"), ChangingCell:=Range("AA15")
    Range("W15").Select
    
'Dividends
    Range("Q25").Select
    Range("Q25").GoalSeek Goal:=Range("AD25"), ChangingCell:=Range("Y25")
    Range("S25").Select
    Range("S25").GoalSeek Goal:=Range("AE25"), ChangingCell:=Range("Z25")
    Range("U25").Select
    Range("U25").GoalSeek Goal:=Range("AF25"), ChangingCell:=Range("AA25")
    Range("W25").Select
    Range("W25").GoalSeek Goal:=Range("AG25"), ChangingCell:=Range("AB25")
    
'Cash & Marketable Securities
    Range("Q36").Select
    Range("Q36").GoalSeek Goal:=Range("AD36"), ChangingCell:=Range("Y36")
    Range("S36").Select
    Range("S36").GoalSeek Goal:=Range("AE36"), ChangingCell:=Range("Z36")
    Range("U36").Select
    Range("U36").GoalSeek Goal:=Range("AF36"), ChangingCell:=Range("AA36")
    Range("W36").Select
    Range("W36").GoalSeek Goal:=Range("AG36"), ChangingCell:=Range("AB36")
    
'Interest (Income)
'Most likely needs to be calculated after Cash & Marketable Securities is calculated because
'it is derived from the outstanding Cash & Marketable Securities
    Range("Q18").Select
    Range("Q18").GoalSeek Goal:=Range("AD18"), ChangingCell:=Range("Y18")
    Range("S18").Select
    Range("S18").GoalSeek Goal:=Range("AE18"), ChangingCell:=Range("Z18")
    Range("U18").Select
    Range("U18").GoalSeek Goal:=Range("AF18"), ChangingCell:=Range("AA18")
    Range("W18").Select
    Range("W18").GoalSeek Goal:=Range("AG18"), ChangingCell:=Range("AB18")
    
'Accounts Receivable
    Range("Q37").Select
    Range("Q37").GoalSeek Goal:=Range("AD37"), ChangingCell:=Range("Y37")
    Range("S37").Select
    Range("S37").GoalSeek Goal:=Range("AE37"), ChangingCell:=Range("Z37")
    Range("U37").Select
    Range("U37").GoalSeek Goal:=Range("AF37"), ChangingCell:=Range("AA37")
    Range("W37").Select
    Range("W37").GoalSeek Goal:=Range("AG37"), ChangingCell:=Range("AB37")
    
'Accounts Receeivable from Related
    Range("Q38").Select
    Range("Q38").GoalSeek Goal:=Range("AD38"), ChangingCell:=Range("Y38")
    Range("S38").Select
    Range("S38").GoalSeek Goal:=Range("AE38"), ChangingCell:=Range("Z38")
    Range("U38").Select
    Range("U38").GoalSeek Goal:=Range("AF38"), ChangingCell:=Range("AA38")
    Range("W38").Select
    Range("W38").GoalSeek Goal:=Range("AG38"), ChangingCell:=Range("AB38")
    
'Inventories
    Range("Q39").Select
    Range("Q39").GoalSeek Goal:=Range("AD39"), ChangingCell:=Range("Y39")
    Range("S39").Select
    Range("S39").GoalSeek Goal:=Range("AE39"), ChangingCell:=Range("Z39")
    Range("U39").Select
    Range("U39").GoalSeek Goal:=Range("AF39"), ChangingCell:=Range("AA39")
    Range("W39").Select
    Range("W39").GoalSeek Goal:=Range("AG39"), ChangingCell:=Range("AB39")
    
'Other Current Assets
    Range("Q40").Select
    Range("Q40").GoalSeek Goal:=Range("AD40"), ChangingCell:=Range("Y40")
    Range("S40").Select
    Range("S40").GoalSeek Goal:=Range("AE40"), ChangingCell:=Range("Z40")
    Range("U40").Select
    Range("U40").GoalSeek Goal:=Range("AF40"), ChangingCell:=Range("AA40")
    Range("W40").Select
    Range("W40").GoalSeek Goal:=Range("AG40"), ChangingCell:=Range("AB40")
    
'Property, Plant, and Equipment, Gross
    Range("Q43").Select
    Range("Q43").GoalSeek Goal:=Range("AD43"), ChangingCell:=Range("Y43")
    Range("S43").Select
    Range("S43").GoalSeek Goal:=Range("AE43"), ChangingCell:=Range("Z43")
    Range("U43").Select
    Range("U43").GoalSeek Goal:=Range("AF43"), ChangingCell:=Range("AA43")
    Range("W43").Select
    Range("W43").GoalSeek Goal:=Range("AG43"), ChangingCell:=Range("AB43")
    
'Intangible Assets
    Range("Q47").Select
    Range("Q47").GoalSeek Goal:=Range("AD47"), ChangingCell:=Range("Y47")
    Range("S47").Select
    Range("S47").GoalSeek Goal:=Range("AE47"), ChangingCell:=Range("Z47")
    Range("U47").Select
    Range("U47").GoalSeek Goal:=Range("AF47"), ChangingCell:=Range("AA47")
    Range("W47").Select
    Range("W47").GoalSeek Goal:=Range("AG47"), ChangingCell:=Range("AB47")
    
'Goodwill
    Range("Q48").Select
    Range("Q48").GoalSeek Goal:=Range("AD48"), ChangingCell:=Range("Y48")
    Range("S48").Select
    Range("S48").GoalSeek Goal:=Range("AE48"), ChangingCell:=Range("Z48")
    Range("U48").Select
    Range("U48").GoalSeek Goal:=Range("AF48"), ChangingCell:=Range("AA48")
    Range("W48").Select
    Range("W48").GoalSeek Goal:=Range("AG48"), ChangingCell:=Range("AB48")
    
'Other Non-Current Assets
    Range("Q49").Select
    Range("Q49").GoalSeek Goal:=Range("AD49"), ChangingCell:=Range("Y49")
    Range("S49").Select
    Range("S49").GoalSeek Goal:=Range("AE49"), ChangingCell:=Range("Z49")
    Range("U49").Select
    Range("U49").GoalSeek Goal:=Range("AF49"), ChangingCell:=Range("AA49")
    Range("W49").Select
    Range("W49").GoalSeek Goal:=Range("AG49"), ChangingCell:=Range("AB49")
    
'Accounts Payable
    Range("Q55").Select
    Range("Q55").GoalSeek Goal:=Range("AD55"), ChangingCell:=Range("Y55")
    Range("S55").Select
    Range("S55").GoalSeek Goal:=Range("AE55"), ChangingCell:=Range("Z55")
    Range("U55").Select
    Range("U55").GoalSeek Goal:=Range("AF55"), ChangingCell:=Range("AA55")
    Range("W55").Select
    Range("W55").GoalSeek Goal:=Range("AG55"), ChangingCell:=Range("AB55")
    
'Accounts Payable from Related Affiliates
    Range("Q56").Select
    Range("Q56").GoalSeek Goal:=Range("AD56"), ChangingCell:=Range("Y56")
    Range("S56").Select
    Range("S56").GoalSeek Goal:=Range("AE56"), ChangingCell:=Range("Z56")
    Range("U56").Select
    Range("U56").GoalSeek Goal:=Range("AF56"), ChangingCell:=Range("AA56")
    Range("W56").Select
    Range("W56").GoalSeek Goal:=Range("AG56"), ChangingCell:=Range("AB56")
    
'Accruals
    Range("Q57").Select
    Range("Q57").GoalSeek Goal:=Range("AD57"), ChangingCell:=Range("Y57")
    Range("S57").Select
    Range("S57").GoalSeek Goal:=Range("AE57"), ChangingCell:=Range("Z57")
    Range("U57").Select
    Range("U57").GoalSeek Goal:=Range("AF57"), ChangingCell:=Range("AA57")
    Range("W57").Select
    Range("W57").GoalSeek Goal:=Range("AG57"), ChangingCell:=Range("AB57")
    
'Other Current Liabilities
    Range("Q61").Select
    Range("Q61").GoalSeek Goal:=Range("AD61"), ChangingCell:=Range("Y61")
    Range("S61").Select
    Range("S61").GoalSeek Goal:=Range("AE61"), ChangingCell:=Range("Z61")
    Range("U61").Select
    Range("U61").GoalSeek Goal:=Range("AF61"), ChangingCell:=Range("AA61")
    Range("W61").Select
    Range("W61").GoalSeek Goal:=Range("AG61"), ChangingCell:=Range("AB61")
    
    
'Short-Term Debt shall be the governing instrument for balancing the Balance Sheet
'Current Maturities, Long Term Debt, Mezzanine Debt, Subordinated Debt shall be governed
'by the respective schedule and shall not be calulated from this macro
        
'Interest Expense
'Most likely needs to be calculated after Debt is calculated because
'it is derived from the outstanding Debt
    Range("Q19").Select
    Range("Q19").GoalSeek Goal:=Range("AD19"), ChangingCell:=Range("Y19")
    Range("S19").Select
    Range("S19").GoalSeek Goal:=Range("AE19"), ChangingCell:=Range("Z19")
    Range("U19").Select
    Range("U19").GoalSeek Goal:=Range("AF19"), ChangingCell:=Range("AA19")
    Range("W19").Select
    Range("W19").GoalSeek Goal:=Range("AG19"), ChangingCell:=Range("AB19")
    
 'Income Taxes
 'Definately needs to be calculated after both Interest expense and interest income
 'because it is below thos lines on the income statement
    Range("Q22").Select
    Range("Q22").GoalSeek Goal:=Range("AD22"), ChangingCell:=Range("Y22")
    Range("S22").Select
    Range("S22").GoalSeek Goal:=Range("AE22"), ChangingCell:=Range("Z22")
    Range("U22").Select
    Range("U22").GoalSeek Goal:=Range("AF22"), ChangingCell:=Range("AA22")
    Range("W22").Select
    Range("W22").GoalSeek Goal:=Range("AG22"), ChangingCell:=Range("AB22")
        
 'Long-Term Provisions
    Range("Q67").Select
    Range("Q67").GoalSeek Goal:=Range("AD67"), ChangingCell:=Range("Y67")
    Range("S67").Select
    Range("S67").GoalSeek Goal:=Range("AE67"), ChangingCell:=Range("Z67")
    Range("U67").Select
    Range("U67").GoalSeek Goal:=Range("AF67"), ChangingCell:=Range("AA67")
    Range("W67").Select
    Range("W67").GoalSeek Goal:=Range("AG67"), ChangingCell:=Range("AB67")
    
'Short-Term Provisions
'Must be calculated AFTER Long-Term Provisions because they are a percentage
'thereof
    Range("Q60").Select
    Range("Q60").GoalSeek Goal:=Range("AD60"), ChangingCell:=Range("Y60")
    Range("S60").Select
    Range("S60").GoalSeek Goal:=Range("AE60"), ChangingCell:=Range("Z60")
    Range("U60").Select
    Range("U60").GoalSeek Goal:=Range("AF60"), ChangingCell:=Range("AA60")
    Range("W60").Select
    Range("W60").GoalSeek Goal:=Range("AG60"), ChangingCell:=Range("AB60")
    
'Deferred Income Taxes
    Range("Q68").Select
    Range("Q68").GoalSeek Goal:=Range("AD68"), ChangingCell:=Range("Y68")
    Range("S68").Select
    Range("S68").GoalSeek Goal:=Range("AE68"), ChangingCell:=Range("Z68")
    Range("U68").Select
    Range("U68").GoalSeek Goal:=Range("AF68"), ChangingCell:=Range("AA68")
    Range("W68").Select
    Range("W68").GoalSeek Goal:=Range("AG68"), ChangingCell:=Range("AB68")
    
'Other Non-Current Liabilites
    Range("Q69").Select
    Range("Q69").GoalSeek Goal:=Range("AD69"), ChangingCell:=Range("Y69")
    Range("S69").Select
    Range("S69").GoalSeek Goal:=Range("AE69"), ChangingCell:=Range("Z69")
    Range("U69").Select
    Range("U69").GoalSeek Goal:=Range("AF69"), ChangingCell:=Range("AA69")
    Range("W69").Select
    Range("W69").GoalSeek Goal:=Range("AG69"), ChangingCell:=Range("AB69")
    
'Reserves
    Range("Q73").Select
    Range("Q73").GoalSeek Goal:=Range("AD73"), ChangingCell:=Range("Y73")
    Range("S73").Select
    Range("S73").GoalSeek Goal:=Range("AE73"), ChangingCell:=Range("Z73")
    Range("U73").Select
    Range("U73").GoalSeek Goal:=Range("AF73"), ChangingCell:=Range("AA73")
    Range("W73").Select
    Range("W73").GoalSeek Goal:=Range("AG73"), ChangingCell:=Range("AB73")
    
'Other Equity
    Range("Q74").Select
    Range("Q74").GoalSeek Goal:=Range("AD74"), ChangingCell:=Range("Y74")
    Range("S74").Select
    Range("S74").GoalSeek Goal:=Range("AE74"), ChangingCell:=Range("Z74")
    Range("U74").Select
    Range("U74").GoalSeek Goal:=Range("AF74"), ChangingCell:=Range("AA74")
    Range("W74").Select
    Range("W74").GoalSeek Goal:=Range("AG74"), ChangingCell:=Range("AB74")
    
End Sub