VBA to run Multiple Goal Seek Loop?

McGu

Board Regular
Joined
Oct 10, 2006
Messages
135
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

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
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
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?


Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

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