I was getting an error when the solver couldn't come up with the answer.
Added logic to handle the error. Now I get the msgbox showing up even when
solver comes up with the answer. What am I doing wrong.

Sub Solve_for_Face()
Dim cntr As Integer
shtSolve.Unprotect "Canada"
If shtSolve.Range("z19").Value < 5000 Then
shtSolve.Range("z19").Value = 5000
End If
shtSolve.Range("aa25").GoalSeek Goal:=shtSolve.Range("aa26"), _
ChangingCell:=shtSolve.Range("z19")

Do
On Error GoTo newprem
shtSolve.Range("z19").Value = Round(shtSolve.Range("z19").Value, 3)
+ 0.001
Loop Until shtSolve.Range("aa25").Value shtSolve.Range("aa26").Value
shtSolve.Range("z19").Value = shtSolve.Range("z19").Value - 0.001
shtSummary.Range("UnitAmt") = Int(shtSolve.Range("z19") * 1000)
shtSummary.Range("UnitADB") = Int(shtSolve.Range("z21") * 1000)
shtSummary.Protect "Canada"
Exit Sub
newprem:
MsgBox "cannot solve for face enter different premium"
shtSummary.Protect "Canada"
End Sub