VBA, Loop Goal Seek of Multiple Rows

Mrworldwide

New Member
Joined
Aug 4, 2020
Messages
1
Office Version
  1. 365
Platform
  1. Windows
I need help with a VBA code I've developed to run several goal seeks across multiple rows. However, in order to goal seek, it needs to run another macro and runs in a loop until all conditions are met. The code is as follows:
VBA Code:
Sub run_sensitivities2()

Application.ScreenUpdating = False

Dim senstivity_var As Double
Dim i As Integer
Application.ScreenUpdating = False

For i = 1 To 16
   
    Sheet10.Select
    Range("Sens2").Select
    Range("Sens2").Offset(i, 0).Select
    senstivity_var = Selection.Value
    Range("EPC").Value = senstivity_var
    Call Run_Goalseek
    Sheet40.Select
    Range("Base2").Select
    Range("Base2").Copy
    Selection.Offset(i, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
              
    Range("Target").Select
    Range("Target").Copy
    Range("Ticket").Select
    Selection.Offset(i, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False

Next
Range("EPC").Value = 1
Call Run_Goalseek

Sheet10.Select

Application.ScreenUpdating = True

End Sub




Sub Run_Goalseek()

Application.ScreenUpdating = False

Dim i As Integer
For i = 1 To 16

Do While Range("Diff").Value <> 0

    With Application
    .MaxIterations = 100
    .MaxChange = 0.001
    End With
   
    Range("IRR").GoalSeek _
        Goal:=Range("TargetIRR"), _
        ChangingCell:=Range("H10").Offset(i, 0).Select

Call Run_Model

Sheet10.Select

Loop

Next



Sub Run_Model()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationSemiautomatic

Range("switch") = 0


Do While Range("FundDiff").Value <> 0 Or Range("CFADS_Diff1").Value <> 0 Or Range("Cashsweep2_Diff1").Value <> 0 Or Range("Cashsweep_Diff1_2").Value <> 0 Or Range("Opex_3_NI_Diff").Value <> 0 Or Range("Fund_Ratio_LLCR_Diff").Value <> 0

Range("RA_Opex_3_NI_Paste").Value = Range("RA_Opex_3_NI_Copy").Value
Range("RA_Debt_2_Cashsweep_Paste1").Value = Range("RA_Debt_2_Cashsweep_Copy1").Value
Range("RA_Debt_Cashsweep_Paste1_2").Value = Range("RA_Debt_Cashsweep_Copy1_2").Value
Range("RA_Fund_FundReq_Paste").Value = Range("RA_Fund_FundReq_Copy").Value
Range("RA_Fund_Ratio_LLCR_Paste").Value = Range("RA_Fund_Ratio_LLCR_Copy").Value
Range("RA_Debt_CFADS_Paste1").Value = Range("RA_Debt_CFADS_Copy1").Value

Loop

Range("RA_Proj_Project_CF_Paste") = Range("RA_Proj_Project_CF_Copy").Value



Range("switch") = 1

Do While Range("FundDiff").Value <> 0 Or Range("CFADS_Diff1").Value <> 0 Or Range("Cashsweep2_Diff1").Value <> 0 Or Range("Cashsweep_Diff1_2").Value <> 0 Or Range("Opex_3_NI_Diff").Value <> 0 Or Range("Fund_Ratio_LLCR_Diff").Value <> 0

Range("RA_Opex_3_NI_Paste").Value = Range("RA_Opex_3_NI_Copy").Value
Range("RA_Debt_2_Cashsweep_Paste1").Value = Range("RA_Debt_2_Cashsweep_Copy1").Value
Range("RA_Debt_Cashsweep_Paste1_2").Value = Range("RA_Debt_Cashsweep_Copy1_2").Value
Range("RA_Fund_FundReq_Paste").Value = Range("RA_Fund_FundReq_Copy").Value
Range("RA_Fund_Ratio_LLCR_Paste").Value = Range("RA_Fund_Ratio_LLCR_Copy").Value
Range("RA_Debt_CFADS_Paste1").Value = Range("RA_Debt_CFADS_Copy1").Value

Loop

Application.ScreenUpdating = True

End Sub


Application.ScreenUpdating = True


End Sub
 
Last edited by a moderator:

Some videos you may like

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)

Watch MrExcel Video

Forum statistics

Threads
1,118,413
Messages
5,571,961
Members
412,429
Latest member
brahmaiah
Top