Auto Tab Naming

Can anyone help me to make the auto naming code displayed on the worksheet tab die after first entry into, so that regardless whether any values are changed in the worksheet--a minute, hour, day after-- the "namedate" stays the same.

Any help would be greatly appreciated.

Private Declare Function sndPlaySound32 Lib "winmm.dll" Alias _
    "sndPlaySoundA" (ByVal lpszSoundName As String, _
    ByVal uFlags As Long) As Long

--------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
    
'Automatically names the worksheet as date

Dim dateTemp As Date

ActiveSheet.Names.Add Name:="_timestamp", RefersTo:=Now()
dateTemp = Val(Mid(ActiveSheet.Names("_timestamp"), 2))

ActiveSheet.Name = Format(dateTemp, "MMM dd.hh.mm.ss")

'Ding Sound whenever values have been keyed
     
Set TargetRange = Range("H50:H51,H102:H103,H154:H155,H206:H207")
Set isect = Intersect(Target, TargetRange)

If Not isect Is Nothing Then
If isect.Count > 1 Then Exit Sub
    If Target.Row Mod 2 = 0 Then
        If Target.Value = "" Or Target.Value = 0 Then Exit Sub
        If Target.Value = Target.Offset(1, 0).Value Then
            sndPlaySound32 "ding", 1&
        End If
    Else
        If Target.Value = "" Or Target.Value = 0 Then Exit Sub
        If Target.Value = Target.Offset(-1, 0).Value Then
            sndPlaySound32 "ding", 1&
        End If
    End If
End If

End Sub