Looping though Rows and Columns while running Goalseek

25 views Asked by At

in an Active Worksheet,

I want to create an array of values where in the Macro copies values from a particular cell (let's say "L5") and paste it into target cell (I4). Thereafter run goal seek and paste back the values in designated cells. Then goes L6 and repeats. Do this until there is no value in Column L.

I tried the below code,and it works. But I want to make it short with variables. At the same time run it as a loop until there is no values in column "L"

Sub SOLVER()

    Range("L5").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M5").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N5").PasteSpecial Paste:=xlPasteValues
    Range("L6").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M6").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N6").PasteSpecial Paste:=xlPasteValues
    Range("L7").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M7").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N7").PasteSpecial Paste:=xlPasteValues
    Range("L8").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M8").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N8").PasteSpecial Paste:=xlPasteValues
    Range("L9").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M9").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N9").PasteSpecial Paste:=xlPasteValues
    Range("L10").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M10").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N10").PasteSpecial Paste:=xlPasteValues
    Range("L11").Copy
    Range("I4").PasteSpecial Paste:=xlPasteValues
    Range("J4").GoalSeek Goal:=0, ChangingCell:=Range("D23")
    Range("D23").Copy
    Range("M11").PasteSpecial Paste:=xlPasteValues
    Range("H5").Copy
    Range("N11").PasteSpecial Paste:=xlPasteValues
    
End Sub
1

There are 1 answers

0
taller On

Pls try.

Option Explicit

Sub SOLVER()
    Dim lastRow As Long, i As Long
    Dim lastRow As Long, oSht As Worksheet
    With Sheets("Sheet1")  ' modify as needed
        lastRow = .Cells(.Rows.Count, "L").End(xlUp).Row
        For i = 5 To lastRow
            .Range("I4").Value = .Range("L" & i).Value
            .Range("J4").GoalSeek Goal:=0, ChangingCell:=.Range("D23")
            .Range("M" & i).Value = .Range("D23").Value
            .Range("N" & i).Value = .Range("H5").Value
        Next
    End With
End Sub