Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
Dim arrA() As String, x
Dim rngSh1 As Range, c As Range
If target.Count > 1 Then Exit Sub
arrA = Split("P19:P803,R19:R803,U19:U803", ",")
For x = LBound(arrA) To UBound(arrA)
If rngSh1 Is Nothing Then
Set rngSh1 = Range(arrA(x))
Else
Set rngSh1 = Union(rngSh1, Range(arrA(x)))
End If
Next x
If Not Intersect(rngSh1, target) Is Nothing Then
Application.EnableEvents = False
target.Value = target.Value + 1
Application.EnableEvents = True
Cancel = True
Exit Sub
End If
arrA = Split("W19:W803,X19:X803,Y19:Y803", ",")
For x = LBound(arrA) To UBound(arrA)
If rngSh1 Is Nothing Then
Set rngSh1 = Range(arrA(x))
Else
Set rngSh1 = Union(rngSh1, Range(arrA(x)))
End If
Next x
If Not Intersect(rngSh1, target) Is Nothing Then
Application.EnableEvents = False
Doit target
Application.EnableEvents = True
Cancel = True
Exit Sub
End If
End Sub
Private Sub Doit(target)
Dim c As Range
Set c = target
If VarType(c.Value) = 5 Then
Select Case Int(c.Value)
Case Is < 1, 7
c.Value = 2
Case Else
c.Value = c.Value + 1
End Select
Else
c.Value = 2
End If
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal target As Range, Cancel As Boolean)
Dim arrA() As String, x
Dim rngSh1 As Range, c As Range
If target.Count > 1 Then Exit Sub
arrA = Split("P19:P803,R19:R803,U19:U803", ",")
For x = LBound(arrA) To UBound(arrA)
If rngSh1 Is Nothing Then
Set rngSh1 = Range(arrA(x))
Else
Set rngSh1 = Union(rngSh1, Range(arrA(x)))
End If
Next x
If Not Intersect(rngSh1, target) Is Nothing Then
Application.EnableEvents = False
target.Value = target.Value - 1
Application.EnableEvents = True
Cancel = True
Exit Sub
End If
End Sub