Locking cell after data is entered

[seljo]

Is there any way to lock a cell after someone enters the data in it and the spreadsheet remains open until the next data point is entered.

 

[HalfAce]

Hello seljo,
If you mean to include all cells in the sheet then you can do this.
1) Press Ctrl+A to select all cells and from the menu choose Format > Cells > Protection tab
and uncheck the 'Locked' checkbox
2) Right click the sheet's name tab and choose View code.
3) Paste this code in the sheet module. Press Alt+Q to get back to the sheet.
4) Protect your sheet. (Tools > Protection > Protect Sheet. -in this case with no password.)

You should be good to go.
Post back if you only meant to include certain cells/ranges or if you do use a password in your
sheet protection.

 

[seljo]

I am wanting to include range B:B and range E:E and yes I do have it password protected.

 

[HalfAce]

Oh, well I suppose it would've helped if I had remembered to post the code!
Following the same instructions above and using this code should do what you're asking.
(You could also select just the columns B & E instead of the entire sheet to unlock if you like.)
Replace both instances of the word Password with your real one.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B:B")) Is Nothing And _
   Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
ActiveSheet.Unprotect "Password"
Target.Locked = True
ActiveSheet.Protect "Password"
End Sub

 

[UPN]

protect

What if i wanted to protect from let say B1 to h100

 

[UPN]

protect

also with no password what would code be

 

[HalfAce]

Hello UPN,

What if i wanted to protect from let say B1 to h100 . . .also with no password what would code be

Following the same instructions above to unlock cells first, this should do that for you.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B1:H100")) Is Nothing Then Exit Sub
ActiveSheet.Unprotect
Target.Locked = True
ActiveSheet.Protect
End Sub