Locking of cells after not working

D

Dazzatron

New Member
Joined
Feb 3, 2025
Messages
6
Office Version
  1. 365
Platform
  1. Windows
Hi all,

Hopefully you can help.
Im continuing on from another colleague.

I have forms at work that need locking once you put your name at the end of each line, then depending on type of job will need same for block or blocks of cells on same form.

The codes i have are (for for 1 column & multiple blocks of cells)
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C40,G40,K40,L:L")) Is Nothing And Target <> "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim pwd As String, fnd As Range, list As Worksheet
    Set list = Sheets("Sheet1 (2)")
    Select Case Target.Column
        Case Is = 3
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("C26:E41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 6
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("G26:H41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 10
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("K26:L41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 11
            Set fnd = list.Range("AK:AK").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & fnd.Offset(, -1) & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
                Range("L" & Target.Row).Resize(, 7).Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.ClearContents
                MsgBox ("Invalid password.  Please try again.")
            End If
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

and (for 1 column and 1 block of cells
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C40,L:L")) Is Nothing And Target <> "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim pwd As String, fnd As Range, list As Worksheet
    Set list = Sheets("Sheet1 (2)")
    Select Case Target.Column
        Case Is = 3
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("C26:E41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 11
            Set fnd = list.Range("AK:AK").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & fnd.Offset(, -1) & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
                Range("L" & Target.Row).Resize(, 7).Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.ClearContents
                MsgBox ("Invalid password.  Please try again.")
            End If
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
but its not working, i did somehow get C26:E41 and G26:H41 in the first example to work somehow but now wont.
I have set the cells i allow for editing as unlocked and the rest locked.
I am new to VBA so have minimal understanding of it. Especially the "case is=" part

I am unable to post copies of these workbooks but can answer your questions as best as allowed to to asist in my quest.

Any help would be much appreciated, this is started to give me a headache lol
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Sort by date Sort by votes
Your "Case" statements use column numbers 3, 6, 10 and 11. These column numbers correspond to columns C, F, J and K. If you look at this part of your code:
VBA Code: 
If Intersect(Target, Range("C40,G40,K40,L:L"))
you will notice that it refers to columns C, G, K and L which don't match you "Case" statements.
 
Upvote 0
You have to change your case numbers to 3, 7, 11 and 12 or change the code to
VBA Code: 
If Intersect(Target, Range("C40,F40,J40,K:K"))
so that the column numbers match the column letters.
 
Upvote 0
Thank you for your help mumps it worked!!

now however i have the issue of case 12 affecting 2 cells that i wish it didnt.
1 cell is just a title cell but the other 'L4' i wish to be able to check password and lock different cells in the workbook. Basically the operator puts their operator stamp in L4 to say the info they put into a9:e23 is true and correct.
can this be done without having to remake the form?
 
Upvote 0
with L4 its the same as case 12, input and check for password in relation to operator number, but instead of locking the target row, i want to lock a group of cells.
I hope im making sense
 
Upvote 0
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C40,G40,K40,L4:L6, L9:L25")) Is Nothing And Target <> "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim pwd As String, fnd As Range, list As Worksheet
    Set list = Sheets("Sheet1 (2)")
    Select Case Target.Column
        Case Is = 3
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("C26:E41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 7
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("G26:H41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 11
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("K26:L41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 12
            Set fnd = list.Range("AK:AK").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & fnd.Offset(, -1) & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
                Range("F" & Target.Row).Resize(, 7).Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.ClearContents
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 12
            Set Find = list.Range("AK:AK").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password For " & fnd.Offset(, -1) & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, -1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
                Range("A9:E23").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.ClearContents
                MsgBox ("Invalid Password. Please Try Again.")
            End If
            
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Without seeing how your data is organized, I'm not quite sure what you are trying to do but see if this works for you:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C40,G40,K40,L4:L6, L9:L25")) Is Nothing And Target <> "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim pwd As String, fnd As Range, list As Worksheet
    Set list = Sheets("Sheet1 (2)")
    Select Case Target.Column
        Case Is = 3
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("C26:E41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 7
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("G26:H41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 11
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("K26:L41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 12
            Set fnd = list.Range("AK:AK").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & fnd.Offset(, -1) & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
                Range("F" & Target.Row).Resize(, 7).Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            ElseIf pwd = fnd.Offset(, -1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
                Range("A9:E23").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.ClearContents
                MsgBox ("Invalid password.  Please try again.")
            End If
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Without seeing how your data is organized, I'm not quite sure what you are trying to do but see if this works for you:
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C40,G40,K40,L4:L6, L9:L25")) Is Nothing And Target <> "" Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim pwd As String, fnd As Range, list As Worksheet
    Set list = Sheets("Sheet1 (2)")
    Select Case Target.Column
        Case Is = 3
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("C26:E41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 7
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("G26:H41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 11
            Set fnd = list.Range("AJ:AJ").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & Target & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 2) Then
                ActiveSheet.Unprotect "123"
                Target.Offset(1) = fnd.Offset(, 1)
                Range("K26:L41").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.Nothing
                MsgBox ("Invalid password.  Please try again.")
            End If
        Case Is = 12
            Set fnd = list.Range("AK:AK").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
            pwd = Application.InputBox("Password for " & fnd.Offset(, -1) & ":", "Enter Password", Type:=2)
            If pwd = fnd.Offset(, 1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
              [COLOR=rgb(184, 49, 47)]  [/COLOR][COLOR=rgb(147, 101, 184)][B]Range("F" & Target.Row).Resize(, 7).Locked = True[/B][/COLOR]
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            ElseIf pwd = fnd.Offset(, -1) Then
                ActiveSheet.Unprotect "123"
                Target.Copy
                Target.Offset(1).PasteSpecial xlPasteValidation
                Range("A9:E23").Locked = True
                ActiveSheet.Protect "123"
                ActiveSheet.EnableSelection = xlUnlockedCells
            Else
                Target.ClearContents
                MsgBox ("Invalid password.  Please try again.")
            End If
    End Select
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
Click to expand...
its not happy with the line I have highlighted in purple when i click L4 and select my option.
"Range("f"&target.row).resize(, 7).locked=true"
F9:k25 are to hold a list of items that the worker dealt with and in column L they select their number to say they completed the items ready for the next part of this job.
a9:e23 contains the details of what happened to the items in the list and l4:l6 (one selection box to select operator number and only this size to square off the form) once the worker selects their number it means they've checked a9:e23 and sign that its all correct.
c26:e41, f26:h41 and k26:L41 are for results of tested parts.
If any part of this form is incorrect or falsified it can/will lead to disciplinary and my colleague Emmily who was advised by an auditor to find a way to secure the form more is currently on long term parental leave so I can not really contact her to finish this form. Hence im now trying.

I appreciate its not easy without looking at the sheet and understanding fully why but i've been told to not share the actual sheet so I will have to find out how I can create an example but doing this will mean whatever code you can create may not transfer very well.

Thank you for your help
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question Question
VBA to lock Cell after Data Entry but still Allow Sort & Filter ?
Replies
3
Views
321
Jeffrey Mahoney
Jeffrey Mahoney
E
  • Solved
Locking of cells with protected sheet not working
Replies
5
Views
499
Eurekaonide
E
Agnarr
  • Question Question
VBA code mix
Replies
1
Views
542
Joe4
Joe4
M
  • Question Question
Add extra line of code to VBA to copy cell value across sheet
Replies
1
Views
210
myall_blues
myall_blues
Agnarr
  • Solved
Calculation Problem VBA
Replies
1
Views
565
Joe4
Joe4

Forum statistics

Threads
1,226,321
Messages
6,190,262
Members
453,603
Latest member
Mitch90

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top