Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("I3")) Is Nothing Then Telephone
If Not Intersect(Target, Range("i7:i20000")) Is Nothing Then
ActiveSheet.Unprotect Password:=""
Target.Offset(0, 2) = Now()
End If
If Not Intersect(Target, Range("l7:l20000")) Is Nothing Then
ActiveSheet.Unprotect Password:=""
Target.Offset(0, -7) = Now()
ActiveSheet.Unprotect Password:=""
Target.Offset(0, 8) = ""
Target.Offset(0, 9) = ""
End If
If Not Intersect(Target, Range("u7:u20000")) Is Nothing Then
ActiveSheet.Unprotect Password:=""
Target.Offset(0, -16) = Now()
End If
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoRestrictions
Application.EnableEvents = True
End Sub
Sub Telephone()
If [h1] = "$I$3" Then Exit Sub
ActiveSheet.Unprotect Password:=""
If [h1] = 9 And IsNumeric([h1]) Then
ActiveSheet.Unprotect Password:=""
[h1] = [E1] & [I3]
End If
End Sub