VBA Loop using solver.

Hi All,

I am currently trying to automate a spreadsheet which uses solver to determine the value of a cell. As with the code below I use input boxes to determine the value of the 'Set Target Cells', of the 'Cells to be changed' and of the 'Contraints'.

I already know what columns which will be selected before hand, and I have 150 rows which I want to run the optimizing function on separately.

TargetVal will always be in column B. ChangeVal will always be in M:V and DesiredVal will always be C:K.

Given I have 150 rows I want to run the solver function in all of them using a loop.

Can anyone please help/advise?

Thanks in advance!!!

Dim TargetVal As Range, ChangeVal As Range, DesiredVal As Range
   
        Cells.Select
    
            With Selection.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        
        With Application

            Set TargetVal = .InputBox(Title:="Select a range in a single row", _
            prompt:="Select your range which contains the ""Set Cell"" range", Default:=Range("C11:E11").Address, Type:=8)
            
            	TargetVal.Font.ColorIndex = 4
         
         
            Set ChangeVal = .InputBox(Title:="Select a range in a single row", _
            prompt:="Select the range of cells that will be changed", Default:=Range("G8:G10").Address, Type:=8)
            
            	ChangeVal.Font.ColorIndex = 10

            Set DesiredVal = .InputBox(Title:="Select a range in a single row", _
            prompt:="Select the range which will constrain the optimizer", Default:=Range("C12:E12").Address, Type:=8)
         
         
            	DesiredVal.Font.ColorIndex = 14
            End With
    
    Application.ScreenUpdating = False
         'Initiate Solver function
    SolverReset
    
        SolverOptions precision:=0.0000001
         
        SolverOk SetCell:=TargetVal.Cells, MaxMinVal:=3, ValueOf:="0""", ByChange:=ChangeVal.Cells
    
        SolverAdd CellRef:=DesiredVal.Cells, Relation:=2, FormulaText:="0"
        
        SolverOk SetCell:=TargetVal.Cells, MaxMinVal:=3, ValueOf:="0", ByChange:=ChangeVal.Cells
             
    SolverSolve True
    
    Application.ScreenUpdating = True
    
End Sub