Private Sub Worksheet_Change(ByVal Target As Range)
Dim pl As Range, c As Range
Set pl = Intersect(Target, Columns(1))
If Not pl Is Nothing Then
For Each c In pl
If Len(c.Value) = 24 And IsNumeric(Left(c.Value, 15)) And IsNumeric(Mid(c.Value, 16)) Then
Application.EnableEvents = False
c.Value = Mid(c, 7, 16)
Application.EnableEvents = True
End If
Next c
End If
End Sub