Try this worksheet event code
Code:
Option Explicit
Private prevVal As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim minVal As Long
Dim maxVal As Long
Dim lastrow As Long
Dim inc As Long
Dim i As Long
On Error GoTo ws_exit
Application.EnableEvents = False
If Target.Count = 1 Then
If Target.Column = 2 Then
If Target.Value < prevVal Then
minVal = Target.Value
maxVal = prevVal
inc = 1
Else
minVal = prevVal
maxVal = Target.Value
inc = -1
End If
lastrow = Me.Cells(Me.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastrow
If i <> Target.Row Then
If Me.Cells(i, "B").Value >= minVal And Me.Cells(i, "B").Value <= maxVal Then
Me.Cells(i, "B").Value = Me.Cells(i, "B").Value + inc
End If
End If
Next i
End If
End If
ws_exit:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Column = 2 Then prevVal = Target.Value
End If
End Sub
Bookmarks