how to protect a cell after input

[ckf]

Hi all together,

I would like to protect CERTAIN CELLS after ONE SINGLE INPUT, to avoid having it changed again.

Is this possible at all and how would I do this?? The formatting is for a date.

Thanks

Karl

 

[Loomah]

Hi Karl
Firstly you will have to unlock ALL the cells that you want to allow input to then protect the sheet.

The next bit involves coding. Add this to the worksheet module that you are working on

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
With Target
    .Locked = True
    .FormulaHidden = False
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

To view the module right click on the sheet you are using and choose View Code. This opens the VBE. From the left dropdon on the RHS of your screen (trust me!) choose workksheet (rather than general) and paste the code

RYMB

;-) If a man says something and there are no women there to hear him, is he still wrong?

 

[mudstuffin]

Here is a slightly different approach to Loomah's.

This only protects a specified range, and allows you to delete/type over the rest of the sheet as normal. You dont need to lock any cells, just paste the code into the worksheet module.

n.b. this assumes that the range to protect is b2:b100.


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

If Union(Target, Range("B2:B100&quot).Address = Range("b2:b100&quot.Address Then
If ActiveCell.Value = "" Then ActiveSheet.Unprotect
If ActiveCell.Value <> &quot;&quot; Then ActiveSheet.Protect
End If

If Union(Target, Range(&quot;B2:B100&quot).Address <> Range(&quot;b2:b100&quot.Address Then
ActiveSheet.Unprotect
End If

End Sub

Hope it helps,




mudstuffin

 

[ckf]

Thanks all together.

What I had until now was the following:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Original As Variant
Dim NewVal As Variant
If Target.Count > 1 Then Exit Sub
If Target.Address = &quot;$A$1&quot; Then
NewVal = Target.Value
Application.EnableEvents = False
Application.Undo
Original = Target.Value
If Original = &quot;&quot; Then
Target = NewVal
Else
MsgBox &quot;No change to this cell is allowed&quot;
End If
Application.EnableEvents = True
End If
End Sub

But this is only good for one cell, I need it for 6 different rows (each 25 cells)
This should avoid that a once entered time cannot be altered and it works, but only with one cell. How to do it for a certain range?

 

[mudstuffin]

CKF,

I've not tried your approach, but you could modify my example to deal with more than 1 row. All you need to do is highlight your 6 rows of 25 cells (using CRTL for each line), then give that range a name, and just adjust the code for the range reference. i.e I have named the 6 rows on my sheet as YourRange....

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

If Union(Target, Range(&quot;YourRange&quot).Address = Range(&quot;YourRange&quot.Address Then
If ActiveCell.Value = &quot;&quot; Then ActiveSheet.Unprotect
If ActiveCell.Value <> &quot;&quot; Then ActiveSheet.Protect
End If

If Union(Target, Range(&quot;YourRange&quot).Address <> Range(&quot;YourRange&quot.Address Then
ActiveSheet.Unprotect
End If

End Sub


Regards,



mudstuffin