Private Sub Worksheet_Change(ByVal R As Range)
If R.Address <> "$C$3" Then Exit Sub
Application.ScreenUpdating = 0
If Not IsNumeric(R) Or R > R(2, 1) Then R = R(2, 1)
Application.EnableEvents = 0
Do Until Round([D5], 2) = 0
R = R + 1
Loop
Application.EnableEvents = 1
End Sub