Sub Circles1()
Dim C As Range
Dim MyRng As Range, V As Shape
Dim X As Integer, G As Integer, R As Integer, D As Integer
'================================================
G = 3
R = 8
Set MyRng = Range("E9:z1008")
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each C In MyRng
    If Cells(C.Row, G) = 0 Then GoTo 1
    If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Value = "UC?E") Then
        Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 3, C.Top + 3, C.Width - 6, C.Height - 6)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 0
        V.Line.Weight = 2.5
        D = D + 1
    End If
1 Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
Sub Circles1()
Dim C As Range
Dim MyRng As Range, V As Shape
Dim X As Integer, G As Integer, R As Integer, D As Integer
'================================================
G = 3
R = 8
Set MyRng = Range("E9:z1008")
'================================================
X = ActiveWindow.Zoom
Application.ScreenUpdating = False
ActiveWindow.Zoom = 100
For Each C In MyRng
    If Cells(C.Row, G) = 0 Then GoTo 1
    If IsNumeric(Cells(R, C.Column)) And Not IsEmpty(Cells(R, C.Column)) And (C.Value < Cells(R, C.Column) Or C.Value = "UC?E") Then
        Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, C.Left + 3, C.Top + 3, C.Width - 6, C.Height - 6)
        V.Fill.Visible = msoFalse
        V.Line.ForeColor.SchemeColor = 0
        V.Line.Weight = 2.5
        D = D + 1
    End If
1 Next
ActiveWindow.Zoom = X
Application.ScreenUpdating = True
MsgBox "E? ??C?E   " & D & "   IC??E E??C?", vbMsgBoxRtlReading, "C???I???"
End Sub