Sub Test()
Dim i As Integer
Dim j As String
[E29].Value = 0
[D3].Select
While ActiveCell.Value <> 1
j = ActiveCell.Value
k = IsNumeric(j)
If k = True Then
If ActiveCell.Value < 8.5 Then [E29].Value = [E29].Value + 1
ActiveCell.Offset(0, 4).Select
Else
ActiveCell.Offset(0, 4).Select
End If
Wend
[E29].Select
End Sub