Timestamp on a protected sheet

Question

Hello,

I have a spreadsheet that is automatically protected after data entry. Kind folks here helped me put in a procedure for protecting and unprotecting data sheet after data entry.

Now, I would like to populate cells E1:E14 if the adjacent cell A1:A14 is populated. But since the worksheet protects itself after data-entry, this is proving to be a bit of a trouble. Can someone please help?

Many Thanks in advance

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    LockUsed

    Me.Save

End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    LockUsed

End Sub

Sub LockUsed()

    Dim trg As Range

    Dim rng As Range

    With Worksheets("Sheet1")

        .Unprotect Password:="secret"

        Set trg = Worksheets("Sheet1").Range("A1:C14")

        On Error Resume Next

        Set rng = trg.SpecialCells(xlCellTypeConstants)

        If Not rng Is Nothing Then

            rng.Locked = True

        End If

        Set rng = Nothing

        Set rng = trg.SpecialCells(xlCellTypeFormulas)

        If Not rng Is Nothing Then

            rng.Locked = True

        End If

        .Protect Password:="secret"

    End With

End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

        With Target

            If .Count > 1 Then Exit Sub

            If Not Intersect(Range("A1:A14"), .Cells) Is Nothing Then

                Application.EnableEvents = False

                If IsEmpty(.Value) Then

                    .Unprotect Password:="secret"

                    .Offset(0, 4).ClearContents

                Else

                    With .Offset(0, 4)

                        .Unprotect Password:="secret"

                        .NumberFormat = "dd mmm yyyy hh:mm:ss"

                        .Value = Now

                    End With

                End If

                Application.EnableEvents = True

            End If

        End With

    End Sub

Answer 1

I'd set the number format of E1:E14 to dd mmm yyyy hh:mm:ss manually - you need to do that only once, no need to do it every time a cell in A1:A14 is changed.

Try this version of the Worksheet_Change event procedure. It also works if multiple cells in A1:A14 are changed simultaneously.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    Dim cel As Range

    If Not Intersect(Range("A1:A14"), Target) Is Nothing Then

        Application.EnableEvents = False

        Me.Unprotect Password:="secret"

        For Each cel In Intersect(Range("A1:A14"), Target)

            If cel.Value = "" Then

                cel.Offset(0, 4).ClearContents

            Else

                cel.Offset(0, 4).Value = Now

            End If

        Next cel

        Me.Protect Password:="secret"

        Application.EnableEvents = True

    End If

End Sub

Answer 2

You are amazing Hans!!!

Thank you for the prompt reply and for all your help.

Kind Regards