Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim R As Integer
If Not Intersect(Target.Cells(1, 1), Union(Range("B2:B10000"), Range("o2:o10000"))) Is Nothing Then
R = Target.Row
If Cells(R, "B").Value <> "" Then
Cells(R, "A").Value = R + 4999
Cells(R, "C").Value = WorksheetFunction.VLookup(Cells(R, "B"), [TUNNEL3], 2, 0)
Cells(R, "D").Value = WorksheetFunction.VLookup(Cells(R, "B"), [TUNNEL3], 3, 0)
Else
Union(Cells(R, "0"), Cells(R, "0")).ClearContents
End If
End If
If Target.Cells.CountLarge > 1 Then Exit Sub
If Target.Row > 1 And Target.Column = 8 Then
With Target.Offset(, 1)
.Formula = "=MOD(" & (Target - Target.Offset(, -1)) & ",1)": .Value = .Value
End With
End If
If Target.Cells.CountLarge > 1 Then Exit Sub
If Target.Row > 1 And Target.Column = 11 Then
With Target.Offset(, 1)
.Formula = "=MOD(" & (Target - Target.Offset(, -4)) & ",1)": .Value = .Value
End With
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B:B")) Is Nothing Then
With Target(1, 3)
.Value = Date
End With
End If
On Error GoTo 0
End Sub