Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vValue
    If Not Intersect(Target, [A1:A10]) Is Nothing Then 'указываем диапазон где нужно работать
        If Target.Count > 1 Then Exit Sub ' если меняем больше одной, то выход
        If Target = "" Then Exit Sub ' если пусто
        Application.EnableEvents = 0
        Application.Undo ' Откат операции
        vValue = Target.Value ' какое там значение раньше было
        Application.Undo ' Обратный откат
        If Target <> vValue Then ' если значение изменилось
            If Target > vValue Then ' если значение изменилось
                Target.Font.Color = RGB(107, 164, 41) 'окрашиваем новые изменения в зеленый цвет
            Else
                Target.Font.Color = RGB(207, 164, 41)
            End If
        End If
        Application.EnableEvents = 1
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim vValue
If Not Intersect(Target, [A1:A10]) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target <> vValue Then Target.Font.Color = RGB(107, 164, 41)
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
  
Application.EnableEvents = False
Application.Undo

vOld = Range("A1").Value
Application.Undo
  
    If Range("A1").Value > vOld Then
        Range("A1").Font.Color = RGB(255, 51, 4)
    Else
        Range("A1").Font.Color = RGB(93, 76, 71)
    End If
      
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
 If Not Intersect(Target, [AK8]) Is Nothing Then
  With ActiveCell
      If .HasFormula Or VarType(.Value) = vbString Then Exit Sub
    On Error Resume Next
    If Target.Offset(0, 1) <> "Нет" Then [E8].Value = [E8].Value + 1
    Cancel = Err = 0
  End With
End If