Lock cells after entry is made

y3kesprit · May 2, 2011

Hello all,

I am trying to use a macro that locks cells V5:V2004 after users have entered data into them.

I have tried the following:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    '   Code goes in the Worksheet specific module
    Dim rng As Range
        '   Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")
        Set rng = Target.Parent.Range("V5:V2004")
             '   Only look at single cell changes
            If Target.Count > 1 Then Exit Sub
            '   Only look at that range
            If Intersect(Target, rng) Is Nothing Then Exit Sub
            '   Action if Condition(s) are met (do your thing here)
            ActiveSheet.Unprotect "manfield"
                Target.Locked = True
            ActiveSheet.Protect "PasswordGoesHere"
End Sub

This works fine. However, I prefer a macro that enables me to click again on the filled-up cell where it would prompt me to enter the password so that I can made changes (and thereafter lock the cell again) The code above does not allow that.

Is this possible? Would appreciate the help!

repairman615 · May 2, 2011

Hello,

Maybe add a selection change event like:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Locked = True Then ActiveSheet.Unprotect If MsgBox("Unlock Cell?", vbYesNo, "?????") = vbYes Then Target.Locked = False ActiveSheet.Protect End If End Sub

repairman615 · May 2, 2011

I think this may be better suited:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Pword As String Dim changed As Range Set changed = Intersect(Target, Range("V5:V2004")) If Not changed Is Nothing Then If Target.Locked = True Then If MsgBox("Unlock Cell?", vbYesNo, "?????") = vbYes Then Pword = InputBox("Enter Password", "BubbleGum") On Error GoTo Getout ActiveSheet.Unprotect Pword Target.Locked = False ActiveSheet.Protect Pword End If End If End If Exit Sub Getout: MsgBox "Wrong Password", vbCritical, "Your Busted" End Sub

y3kesprit · May 3, 2011

repairman615 said:
I think this may be better suited:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Pword As String
Dim changed As Range

Set changed = Intersect(Target, Range("V5:V2004"))

If Not changed Is Nothing Then

If Target.Locked = True Then

If MsgBox("Unlock Cell?", vbYesNo, "?????") = vbYes Then
Pword = InputBox("Enter Password", "BubbleGum")
On Error GoTo Getout
ActiveSheet.Unprotect Pword
Target.Locked = False

ActiveSheet.Protect Pword
End If

End If

End If
Exit Sub
Getout: MsgBox "Wrong Password", vbCritical, "Your Busted"

End Sub

Hmmm doesn't work. Is there anything I must edit or change to the code you provided?

I added it in, and made sure that all cells are 'unlocked' before applying the code. I also tried to put a password to the sheet. However V5:V2004 can still be edited without restriction!

repairman615 · May 3, 2011

I thought the code you posted worked for locking the cells??

Here is what I was using in the sheet module:

Private Sub Worksheet_Change(ByVal Target As Range) ' ' Code goes in the Worksheet specific module ' Dim rng As Range ' ' Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3") ' Set rng = Target.Parent.Range("V5:V2004") ' ' Only look at single cell changes ' If Target.Count > 1 Then Exit Sub ' ' Only look at that range ' If Intersect(Target, rng) Is Nothing Then Exit Sub ' ' Action if Condition(s) are met (do your thing here) ' ActiveSheet.Unprotect "manfield" ' Target.Locked = True ' ActiveSheet.Protect "PasswordGoesHere" Dim changed As Range Set changed = Intersect(Target, Range("V5:V2004")) If Not changed Is Nothing Then If Target.Locked <> True Then Target.Locked = True Else End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Pword As String Dim changed As Range Set changed = Intersect(Target, Range("V5:V2004")) If Not changed Is Nothing Then If Target.Locked = True Then If MsgBox("Unlock Cell?", vbYesNo, "?????") = vbYes Then Pword = InputBox("Enter Password", "BubbleGum") On Error GoTo Getout ActiveSheet.Unprotect Pword Target.Locked = False ActiveSheet.Protect Pword End If End If End If Exit Sub Getout: MsgBox "Wrong Password", vbCritical, "Your Busted" End Sub

y3kesprit · May 3, 2011

Code:

[FONT=Courier][COLOR=#00007f]Private[/COLOR] [COLOR=#00007f]Sub[/COLOR] Worksheet_Change([COLOR=#00007f]ByVal[/COLOR] Target [COLOR=#00007f]As[/COLOR] Range)
[COLOR=#007f00]'    '   Code goes in the Worksheet specific module[/COLOR]
[COLOR=#007f00]'    Dim rng As Range[/COLOR]
[COLOR=#007f00]'        '   Set Target Range, i.e. Range("A1, B2, C3"), or Range("A1:B3")[/COLOR]
[COLOR=#007f00]'        Set rng = Target.Parent.Range("V5:V2004")[/COLOR]
[COLOR=#007f00]'             '   Only look at single cell changes[/COLOR]
[COLOR=#007f00]'            If Target.Count > 1 Then Exit Sub[/COLOR]
[COLOR=#007f00]'            '   Only look at that range[/COLOR]
[COLOR=#007f00]'            If Intersect(Target, rng) Is Nothing Then Exit Sub[/COLOR]
[COLOR=#007f00]'            '   Action if Condition(s) are met (do your thing here)[/COLOR]
[COLOR=#007f00]'            ActiveSheet.Unprotect "manfield"[/COLOR]
[COLOR=#007f00]'                Target.Locked = True[/COLOR]
[COLOR=#007f00]'            ActiveSheet.Protect "PasswordGoesHere"[/COLOR]

[COLOR=#00007f]Dim[/COLOR] changed [COLOR=#00007f]As[/COLOR] Range

[COLOR=#00007f]Set[/COLOR] changed = Intersect(Target, Range("V5:V2004"))



[COLOR=#00007f]If[/COLOR] [COLOR=#00007f]Not[/COLOR] changed [COLOR=#00007f]Is[/COLOR] [COLOR=#00007f]Nothing[/COLOR] [COLOR=#00007f]Then[/COLOR]
    [COLOR=#00007f]If[/COLOR] Target.Locked <> [COLOR=#00007f]True[/COLOR] [COLOR=#00007f]Then[/COLOR]
        
       
        Target.Locked = [COLOR=#00007f]True[/COLOR]
       
    [COLOR=#00007f]Else[/COLOR]
        
        
        
    [COLOR=#00007f]End[/COLOR] [COLOR=#00007f]If[/COLOR]
[COLOR=#00007f]End[/COLOR] [COLOR=#00007f]If[/COLOR]

[COLOR=#00007f]End[/COLOR] [COLOR=#00007f]Sub[/COLOR]

[COLOR=#00007f]Private[/COLOR] [COLOR=#00007f]Sub[/COLOR] Worksheet_SelectionChange([COLOR=#00007f]ByVal[/COLOR] Target [COLOR=#00007f]As[/COLOR] Range)
    [COLOR=#00007f]Dim[/COLOR] Pword [COLOR=#00007f]As[/COLOR] [COLOR=#00007f]String[/COLOR]
    [COLOR=#00007f]Dim[/COLOR] changed [COLOR=#00007f]As[/COLOR] Range
    
    [COLOR=#00007f]Set[/COLOR] changed = Intersect(Target, Range("V5:V2004"))
    
    [COLOR=#00007f]If[/COLOR] [COLOR=#00007f]Not[/COLOR] changed [COLOR=#00007f]Is[/COLOR] [COLOR=#00007f]Nothing[/COLOR] [COLOR=#00007f]Then[/COLOR]
    
        [COLOR=#00007f]If[/COLOR] Target.Locked = [COLOR=#00007f]True[/COLOR] [COLOR=#00007f]Then[/COLOR]
            
            [COLOR=#00007f]If[/COLOR] MsgBox("Unlock Cell?", vbYesNo, "?????") = vbYes [COLOR=#00007f]Then[/COLOR]
                Pword = InputBox("Enter Password", "BubbleGum")
                [COLOR=#00007f]On[/COLOR] [COLOR=#00007f]Error[/COLOR] [COLOR=#00007f]GoTo[/COLOR] Getout
                ActiveSheet.Unprotect Pword
            Target.Locked = [COLOR=#00007f]False[/COLOR]
                
                ActiveSheet.Protect Pword
            [COLOR=#00007f]End[/COLOR] [COLOR=#00007f]If[/COLOR]
            
        [COLOR=#00007f]End[/COLOR] [COLOR=#00007f]If[/COLOR]
        
    [COLOR=#00007f]End[/COLOR] [COLOR=#00007f]If[/COLOR]
    [COLOR=#00007f]Exit[/COLOR] [COLOR=#00007f]Sub[/COLOR]
Getout: MsgBox "Wrong Password", vbCritical, "Your Busted"
    
[COLOR=#00007f]End[/COLOR] [COLOR=#00007f]Sub[/COLOR][/FONT]

Hi there, this is the code that you provided. I changed all passwords to 'Manfield'. Applied the code.

Here's what happened:
When I click on cell V5 and type some data inside, the cell becomes locked after I move on to cell V6. When I click back on cell V5, this message pops up,

Unlock Cells? Yes or No

Upon clicking Yes, it prompts for a password, and I keyed in Manfield.
The password window disappear and I proceed to re enter or edit the cell V5. However upon clicking enter, an error appears.

Run-time error '1004'
Unable to set the Locked property of the Range class.

I clicked Debug and this line is highlighted

Target.Locked = True

repairman615 · May 3, 2011

Hmm?

maybe the addition of protection would do...

 ActiveSheet.Unprotect ("") Target.Locked = True ActiveSheet.Protect ("")

repairman615 · May 3, 2011

Don't forget to add your password into the ("").

y3kesprit · May 3, 2011

repairman615 said:
Don't forget to add your password into the ("").

Grrrr, still the same problem.

Do you mind linking all the parts for me? I am a total amateur at this and I wouldn't know where to add in passwords or whatever if you didn't say... My apologies for troubling you.

repairman615 · May 3, 2011

No trouble.
However if this doesn't get it I may Log off for the night.
zzzzzzz.

Private Sub Worksheet_Change(ByVal Target As Range) Dim changed As Range Set changed = Intersect(Target, Range("V5:V2004")) If Not changed Is Nothing Then If TargetLocked <> True Then ActiveSheet.Unprotect ("Manfeild") Target.Locked = True ActiveSheet.Protect ("Manfeild") Else End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Pword As String Dim changed As Range Set changed = Intersect(Target, Range("V5:V2004")) If Not changed Is Nothing Then If Target.Locked = True Then If MsgBox("Unlock Cell?", vbYesNo, "?????") = vbYes Then Pword = InputBox("Enter Password", "BubbleGum") On Error GoTo Getout ActiveSheet.Unprotect Pword Target.Locked = False ActiveSheet.Protect Pword End If End If End If Exit Sub Getout: MsgBox "Wrong Password", vbCritical, "Your Busted" End Sub

Lock cells after entry is made

y3kesprit

Board Regular

Excel Facts

repairman615

Well-known Member

repairman615

Well-known Member

y3kesprit

Board Regular

repairman615

Well-known Member

y3kesprit

Board Regular

repairman615

Well-known Member

repairman615

Well-known Member

y3kesprit

Board Regular

repairman615

Well-known Member

Similar threads

Forum statistics

Share this page

Lock cells after entry is made

Board Regular

Excel Facts

Well-known Member

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock