0

i am having trouble creating an efficient code that loops and returns the result for 7 scenarios starting in a particular cell and having each scenario return in the cell immediately below the particular cell.

Thank you for your help and apologies for my noob skill level.

The long-form script I'm running is this:

Sub Macro1()

    Dim X As Worksheet
    Dim Y As Worksheet
    Set X = Sheets("Scenarios")
    Set Y = Sheets("Portfolio Model")
    
    'Run Flat Scenarios
    X.Select
    Range("M2").Select
    If Range("M2") = "N" Then Range("M2").Value = "Y" Else Range("M2").Value = "Y"
                
    '#1 Flat Scenario
    Y.Select
    Range("GO8").Select
        Selection.Copy
    Range("G3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Calculate
    Range("GK5").Select
        Selection.Copy
    Range("GP8").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
                
    '#2 Flat Scenario
    Y.Select
    Range("GO9").Select
        Selection.Copy
    Range("G3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Calculate
    Range("GK5").Select
        Selection.Copy
    Range("GP9").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
                
    '#3 Flat Scenario
    Y.Select
    Range("GO10").Select
        Selection.Copy
    Range("G3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Calculate
    Range("GK5").Select
        Selection.Copy
    Range("GP10").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
                
    '#4 Flat Scenario
    Y.Select
    Range("GO11").Select
        Selection.Copy
    Range("G3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Calculate
    Range("GK5").Select
        Selection.Copy
    Range("GP11").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    
    '#5 Flat Scenario
    Y.Select
    Range("GO12").Select
        Selection.Copy
    Range("G3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Calculate
    Range("GK5").Select
        Selection.Copy
    Range("GP12").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    
    '#6 Flat Scenario
    Y.Select
    Range("GO13").Select
        Selection.Copy
    Range("G3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Calculate
    Range("GK5").Select
        Selection.Copy
    Range("GP13").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    
    '#7 Flat Scenario
    Y.Select
    Range("GO14").Select
        Selection.Copy
    Range("G3").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    Calculate
    Range("GK5").Select
        Selection.Copy
    Range("GP14").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    
End Sub

This is where I am at in terms of making that script more efficient and attempting to run in loops:

Sub Macro2()

    Dim X As Worksheet
    Dim Y As Worksheet
    Set X = Sheets("Scenarios")
    Set Y = Sheets("Portfolio Model")
    
    'Run Flat Scenarios
    X.Select
    Range("M2").Select
    If Range("M2") = "N" Then Range("M2").Value = "Y" Else Range("M2").Value = "Y"
            
    Dim j As Variant
    Dim jArray As Variant
    jArray = Array(0.085, 0.0875, 0.09, 0.0925, 0.095, 0.0975, 0.01)

    Dim i As Variant
    Dim iArray As Variant
    iArray = Array(1, 2, 3, 4, 5, 6, 7)
    
    For Each i In iArray
        Range("GK5").Copy
        Range("GP" & 7 + i).PasteSpecial xlValues
    
        For Each j In jArray
            Range("G3").Value = j
            Calculate
        Next
    Next

End Sub
Improve this question
2
  • And whats is not working as expected? You may have also a look onto stackoverflow.com/questions/10714251/… Commented Nov 7, 2024 at 21:45
  • Where does Array(0.085, 0.0875, 0.09, 0.0925, 0.095, 0.0975, 0.01) come from in your second code block? Were those values in worksheet cells in the first example? Commented Nov 7, 2024 at 22:11

3 Answers 3

Reset to default
2

Improving Macro Recorder Code: Coding Scenarios

Reading from Cells

  • Here the number of scenarios is defined by a constant.
  • Also, a constant for the column offset (GO:GP) is used.
Sub Macro1()

    ' Define constants.
    Const SCENARIOS_COUNT As Long = 7
    Const COLUMN_OFFSET As Long = 1

    ' Reference the workbook and worksheets.
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' If it isn't, reference it by its name or use 'ActiveWorkbook'.

    Dim sws As Worksheet: Set sws = wb.Sheets("Scenarios")
    Dim pws As Worksheet: Set pws = Sheets("Portfolio Model")
    
    'Run Flat Scenarios
    
    With sws.Range("M2")
        If .Value = "N" Then .Value = "Y" Else .Value = "N" ' !?!
    End With
                
    With pws
        Dim fcell As Range: Set fcell = .Range("GO8")
        Dim RowOffset As Long
        For RowOffset = 0 To SCENARIOS_COUNT - 1
            .Range("G3").Value = fcell.Offset(RowOffset).Value
            .Calculate
            fcell.Offset(RowOffset, COLUMN_OFFSET).Value = .Range("GK5").Value
        Next RowOffset
    End With
    
End Sub

Reading from Array

  • Here the number of scenarios is defined by the number of elements in the array.
  • The column offset constant is not needed since the first cell is in column GP. The values in GO are replaced by the values in the array.
Sub Macro2()

    ' Define constants.
    Dim VALUES() As Variant: VALUES = VBA.Array( _
        0.085, 0.0875, 0.09, 0.0925, 0.095, 0.0975, 0.01)

    ' Reference the workbook and worksheets.
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' If it isn't, reference it by its name or use 'ActiveWorkbook'.

    Dim sws As Worksheet: Set sws = wb.Sheets("Scenarios")
    Dim pws As Worksheet: Set pws = Sheets("Portfolio Model")
    
    'Run Flat Scenarios
    
    With sws.Range("M2")
        If .Value = "N" Then .Value = "Y" Else .Value = "N" ' !?!
    End With
                
    With pws
        Dim fcell As Range: Set fcell = .Range("GP8")
        Dim Index As Long
        For Index = 0 To UBound(VALUES)
            .Range("G3").Value = VALUES(Index)
            .Calculate
            fcell.Offset(Index).Value = .Range("GK5").Value
        Next Index
    End With
    
End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

Comments

2

It could be a very straightforward solution without loops by isolating the repetitive code in a single function (Sub).

The advantage here is clarity. Also, see how to avoid using Select in your code.

Option Explicit

Sub RunScenario(ByRef src1 As Range, ByRef dest1 As Range, _
             ByRef src2 As Range, ByRef dest2 As Range)
    dest1.Value = src1.Value
    '--- if the calculation mode is xlAutomatic (which is the
    '    usual default in Excel) then executing "Calculate"
    '    is not necessary
    dest2.Value = src2.Value
End Sub

Sub Main1()
    Dim scenarios As Worksheet
    Dim portfolios As Worksheet
    Set scenarios = ThisWorkbook.Worksheets("Scenarios")
    Set portfolios = ThisWorkbook.Worksheets("Portfolio Model")
    
    '--- Flat scenarios
    scenarios.Range("M2") = "Y"
    With portfolios
        RunScenario .Range("GO8"), .Range("G3"), .Range("GK5"), Range("GP8")
        RunScenario .Range("GO9"), .Range("G3"), .Range("GK5"), Range("GP9")
        RunScenario .Range("GO10"), .Range("G3"), .Range("GK5"), Range("GP10")
        RunScenario .Range("GO11"), .Range("G3"), .Range("GK5"), Range("GP11")
        RunScenario .Range("GO12"), .Range("G3"), .Range("GK5"), Range("GP12")
        RunScenario .Range("GO13"), .Range("G3"), .Range("GK5"), Range("GP13")
        RunScenario .Range("GO14"), .Range("G3"), .Range("GK5"), Range("GP14")
    End With
End Sub
Improve this answer

Comments

2

Just looking at your first listing, you could loop like this:

Sub Tester()

    Dim wsScen As Worksheet, wsPM As Worksheet
    Dim i As Long
    
    Set wsScen = ThisWorkbook.Worksheets("Scenarios")
    Set wsPM = ThisWorkbook.Worksheets("Portfolio Model")
    
    'Run Flat Scenarios
    wsScen.Range("M2").Value = IIf(wsScen.Range("M2").Value = "N", "Y", "N")
    
    For i = 8 To 14
        wsPM.Range("G3").Value = wsPM.Cells(i, "GO").Value
        Calculate
        wsPM.Cells(i, "GP").Value = wsPM.Range("GK5").Value
    Next i

End Sub
Improve this answer

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.