Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range
If Target.Cells.Count > 1 Then Exit Sub
With Columns("B")
Set Rng = Range(.Cells(15), .Cells(.Cells.Count))
End With
If Intersect(Rng, Target) Is Nothing Then Exit Sub
If IsNumeric(Target.Value) = False Or Target.Value <> 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
With Columns("B")
Range(.Cells(Target.Row + 1), .Cells(.Cells.Count)).Clear
Set Rng = Range(.Cells(1), Target.Offset(-1))
End With
On Error Resume Next
With Rng
.Clear
.FormulaR1C1 = "=IF(R[1]C+4<=R2C1,R[1]C+4,"""")"
.SpecialCells(-4123, 16).Clear
.Value = .Value
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub