Excel VBA Macro Solver Doubt - Infinite Loop

[rohankekatpure1987]

It seems like this is going to be simple, but I can't figure out the correct way to fix my infinite loop problem.

I have a worksheet (Batch Sizing) which leverages Excel solver to find the right optimized batch size for planning. I'm worried about the placement of End statement as the routine is going in infinite loop. Here is my routine:

RecSol()
  Dim i As Long
  Dim Output As Range, rZ As Range, inputrange As Range
  
  'Screen off, runs faster
  Application.ScreenUpdating = False
  'Refer to this sheet
  With Worksheets("Batch Sizing")
  Set sh = ThisWorkbook.Sheets("Batch Sizing")
    i = 6
    Do While Cells(i, "y") <> ""
      
      Set Output = .Range("Y" & i)
      Set commitment = .Range("X" & i)
      Set batchreq = .Range("H" & i)
      Set inputrange = .Range("P" & i & ":T" & i)
      
      SolverReset
      SolverOk SetCell:=Output.Address, _
        MaxMinVal:=2, ValueOf:=0, _
        ByChange:=inputrange.Address
        
    'Check for RRS'
    If Trim(sh.Cells(i, "G")) = "Runner" Then
    SolverAdd CellRef:=inputrange.Address, Relation:=4, FormulaText:="integer"
    SolverAdd CellRef:=inputrange.Address, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=commitment.Address, Relation:=1, FormulaText:="1.0*$H$" & i
    SolverAdd CellRef:=commitment.Address, Relation:=3, FormulaText:="1.0*$H$" & i
    End If
    
    If Trim(sh.Cells(i, "G")) = "Repeater" Then
    SolverAdd CellRef:=inputrange.Address, Relation:=4, FormulaText:="integer"
    SolverAdd CellRef:=inputrange.Address, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=commitment.Address, Relation:=1, FormulaText:="0.9*$H$" & i
    SolverAdd CellRef:=commitment.Address, Relation:=3, FormulaText:="1.0*$H$" & i
    End If
    
    If Trim(sh.Cells(i, "G")) = "Stranger" Then
    SolverAdd CellRef:=inputrange.Address, Relation:=4, FormulaText:="integer"
    SolverAdd CellRef:=inputrange.Address, Relation:=3, FormulaText:="0"
    SolverAdd CellRef:=commitment.Address, Relation:=1, FormulaText:="1.0*$H$" & i
    SolverAdd CellRef:=commitment.Address, Relation:=3, FormulaText:="1.1*$H$" & i
    End If
    
   
   SolverSolve True
    i = i + 1
    Loop
  End With
  Application.ScreenUpdating = True
End Sub

Can you help me why my routine is in infinite loop? Kindly suggest a solution.

Thanks!

 

[AFPathfinder]

The culprit would have to be in the While statement that it's not catching a false to Cells(i, "y") <> ""

My first thought would be to change the Do Loop to a For Loop which is less likely to run into an infinity problem (most use an Integer variable to define the last row). If you're set in using the Do While loop, I'd say step through the code until you get to the part where it should be stopping and use the immediate window to check the value of Cells(i, "y").