Help needed with Solver macro
 

I am trying to use following macro, but the Excel stop executing in
after 20 rows and gives me a message: "Unexpected internal error
occured, or available memory is exhausted" I tried to run it without
macro and it works fine.

Can any1 help me with this?
Thank you


Private Sub CommandButton1_Click()

For i = 1 To 290
Application.ScreenUpdating = False


SolverOk SetCell:=Range("$it$4").Offset(i, 0), MaxMinVal:=2,
ValueOf:="0", ByChange:=Range("$hx$4:$hy$4").Offset(i, 0)
SolverAdd CellRef:=Range("$hx$4").Offset(i, 0), Relation:=3,
FormulaText:="0.0000001"
SolverAdd CellRef:=Range("$hy$4").Offset(i, 0), Relation:=3,
FormulaText:="0.0000001"

SolverSolve UserFinish:=True

SolverDelete CellRef:=Range("$hx$4").Offset(i, 0), Relation:=3,
FormulaText:="0.0000001"
SolverDelete CellRef:=Range("$hy$4").Offset(i, 0), Relation:=3,
FormulaText:="0.0000001"
Application.ScreenUpdating = True
Range("it1") = i

Next i

End Sub