Locking cells after entry using VBA

[Cossie]

G'day everyone ~ Thanks again for your assistance

I am trying to write some code that will allow me to lock cells after data has been entered.

What i have in my example code below locks cell b1. What i would like is to lock a range of cells after a user has entered some information.

eg user enters data in cells A1:F1 and then these cells lock. The next user enters data into A2:F2 and thes cells then lock and the next users enters data into A3:F3 and these cells then lock etc etc etc.

This is what I have at the moment:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Answ, Rng As Range

Application.ScreenUpdating = False
Set Rng = Application.Intersect(Target, Range("b1"))
If Target.Cells.Count > 1 Then Exit Sub
If Not Rng Is Nothing Then
Answ = MsgBox("This cell will now be locked.", vbOKCancel, "Confirm Change")
If Answ <> vbOK Then
Application.EnableEvents = False
Target.ClearContents 'clear contents if cancel is pressed
Application.EnableEvents = True
Exit Sub
End If
ActiveSheet.Unprotect "1"
Target.Locked = True
ActiveSheet.Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
Application.ScreenUpdating = True
End Sub

 

[erik.van.geit]

Hi, Cossie,

is this useful ?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Answ As String
Application.ScreenUpdating = False
Answ = MsgBox("This range will now be locked.", vbOKCancel, "Confirm Change")
  If Answ <> vbOK Then
  Application.EnableEvents = False
  Target.ClearContents 'clear contents if cancel is pressed
  Application.EnableEvents = True
  Exit Sub
  End If
ActiveSheet.Unprotect "1"
Target.Locked = True
ActiveSheet.Protect Password:="1", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub

regards,
Erik

 

[DRJ]

Try this

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Rng             As Range
Dim Cell            As Object

    Set Rng = Range("A" & Target.Row & ":F" & Target.Row)
    For Each Cell In Rng
        If Cell.Value = vbNullString Then Exit Sub
    Next
    Sheets("Sheet1").Unprotect Password:="1"
    Rng.Locked = True
    Sheets("Sheet1").Protect Password:="1"

End Sub

You can add in your message here and clear either the target or the whole range if the user does not select OK.

 

[Cossie]

Thanks for the responses I will give them a try

 

[DRJ]

You're Welcome

Post back if there are any problems.

 

[erik.van.geit]

You're welcome,
take a look at this if you want only the next row to be unlocked
you could adapt it to your needs (only a range)
so if data are entered in A1 to F1, next time they could only be entered in A2 to F2, ...
http://www.mrexcel.com/board2/viewtopic.php?t=85211&highlight=

regards,
Erik

 

[pankaj2610]

Unable to open the attachment

 

[Bobilly23]

Hi Erik,

I used your code to try and lock Rows A through R for the targeted row. I am getting a 424 error with the "Target.Locked = True" code. Could I get some help on a code that would solve the error?

Sub Worksheet_Change()
Dim Answ As String
Application.ScreenUpdating = False
Answ = MsgBox("This range will now be locked.", vbOKCancel, "Confirm Change")
  If Answ <> vbOK Then
  Application.EnableEvents = False
  Target.ClearContents 'clear contents if cancel is pressed
  Application.EnableEvents = True
  Exit Sub
  End If
ActiveSheet.Unprotect "bob"
Target.LockedRow = True
ActiveSheet.Protect Password:="bob", DrawingObjects:=True, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True
End Sub

 

[RoryA]

Your declaration line is wrong - it must be as in the original posts:

Private Sub Worksheet_Change(ByVal Target As Range)

 

[Bobilly23]

Your declaration line is wrong - it must be as in the original posts:

Private Sub Worksheet_Change(ByVal Target As Range)

I fixed the code, but it isn't showing up in my macro list when trying to run and test it. What would active the macro to lock the row?