Locking cells in VBA output / limited edits allowed

[geperi]

Hi,

I have the following issue, where I have a VBA code in a page that gives me an output in columns 17-20, based on inputs ('X's I fill in) in columns 13-16.

I would like to lock columns 16 onwards, but I still want the output to change when I add/delete X's in rows 13-16. I want to avoid someone changing the date manually in columns 17-20, but giving the option to change it to Now by changing the X in 13-16.

My code looks like this:

Private Sub Worksheet_Change(ByVal Target As Range)


' limit to a single cell
If Target.Count > 1 Then Exit Sub
' exclude top row
If Target.Row < 6 Then Exit Sub
' exclude columns before M or after O
If Target.Column < 13 Or Target.Column > 16 Then Exit Sub


'don't let this procedure call itself
Application.EnableEvents = False


'put in date and time
If Target.Value <> "" Then
    Target.Offset(, 4) = Now
Else
    Target.Offset(, 4) = ""
End If


're-enable events
Application.EnableEvents = True


End Sub

my columns of interest look similar to the below. When I delete an X the date should be able to disappear, and when I add it back it should re-appear (updated to the time of me adding the X), but other than this no manual changes should be allowed to Cols 17-20. Is something like this possible using VBA or something else?

Col 13	Col14	Col15	Col16	Col17	Col18	Col19	Col20
x	x			7/3/17 7PM	7/3/17 8PM
		x	x			7/4/17 7AM	7/4/17 9AM

<tbody>
</tbody>

 

[NoSparks]

First unlock all cells.
Second lock just the cells you don't want editable.
Third protect the worksheet.
https://support.office.com/en-us/ar...orksheet-75481b72-db8a-4267-8c43-042a5f2cd93a

Then

Private Sub Worksheet_Change(ByVal Target As Range)

' limit to a single cell
If Target.Count > 1 Then Exit Sub
' exclude top row
If Target.Row < 6 Then Exit Sub
' exclude columns before M or after O
If Target.Column < 13 Or Target.Column > 16 Then Exit Sub

'incase of error make sure protected and enabled
    On Error GoTo CleanUp
    
'don't let this procedure call itself
    Application.EnableEvents = False

'unprotect sheet
    ActiveSheet.Unprotect

'put in date and time
    If Target.Value <> "" Then
        Target.Offset(, 4) = Now
    Else
        Target.Offset(, 4) = ""
    End If

'reprotect sheet
    ActiveSheet.Protect
're-enable events
    Application.EnableEvents = True

'thing completed normal so exit sub
    Exit Sub

'jumps to here on error
CleanUp:
    MsgBox "An error occurred"
'reprotect sheet
    ActiveSheet.Protect
're-enable events
    Application.EnableEvents = True

End Sub

 

[mikerickson]

A different approach.
Eliminate the event code.
Use this UDF()

Function TriggeredDate(Trigger as Variant) As Date
    TriggeredDate = Date
Exit Function

Unprotect the whole sheet.
Unlock columns M:P
Lock columns Q:T
Put =TriggeredDate(M1) in Q1 and drag that formula right to column T and down as far as needed.
Protect the worksheet.

TriggeredDate is a non-volatile Date function that will recalculate only if the precedent cells are changed.