VBA lock cells to data entry after approval

J

jflanegan

New Member
Joined
Mar 21, 2022
Messages
3
Office Version
  1. 365
Platform
  1. Windows
I have a tracker that has an Approval column. Once a row of Data has been Approved or Denied I would to lock certain cells in that row. When the Approval column cell is blank I want the cells in that row to be unlocked.

Here is what I have so far but am running into Run-time error '91' Object Variable or with block variable not set.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rInt As Range
    Dim rCell As Range
    Dim tCell As Range

    Set rInt = Intersect(Target, Range("n:n"))
    If rInt = Sheets("Data").Range("M4") Then
        Worksheets("CL 2 Request").Unprotect ("Secret")
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 1)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 2)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 3)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 4)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 5)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 6)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 7)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 8)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 9)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 10)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 11)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 12)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 13)
            tCell.Locked = True
        Next
        Worksheets("CL 2 Request").Protect Password:="Secret", DrawingObjects:=False, contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
   
   ElseIf rInt = Sheets("Data").Range("M5") Then
        Worksheets("CL 2 Request").Unprotect ("Secret")
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 1)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 2)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 3)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 4)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 5)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 6)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 7)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 8)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 9)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 10)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 11)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 12)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 13)
            tCell.Locked = True
        Next
         Worksheets("CL 2 Request").Protect Password:="Secret", DrawingObjects:=False, contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
    
    ElseIf rInt = Sheets("Data").Range("M3") Then
        Worksheets("CL 2 Request").Unprotect ("Secret")
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 1)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 2)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 3)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 4)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 5)
            tCell.Locked = True
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 6)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 7)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 8)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 9)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 10)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 11)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 12)
            tCell.Locked = False
        Next
        For Each rCell In rInt
            Set tCell = rCell.Offset(0, 0 - 13)
            tCell.Locked = False
        Next
         Worksheets("CL 2 Request").Protect Password:="Secret", DrawingObjects:=False, contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
    End If
End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
Hi & welcome to MrExcel!

If object references are to be compared to each other, then the = operator doesn't fit and results in a run-time error. Instead the Is operator is needed.
So code like this
VBA Code: 
ElseIf rInt = Sheets("Data").Range("M3") Then
needs to be changed like this
VBA Code: 
ElseIf rInt Is Sheets("Data").Range("M3") Then

That said, none of the If statements will then evaluate to True since column N:N doesn't intersect with any of the cells involved in column M:M.

As I don't have insight in your data I'm not able to assist any further at this point.
 
Upvote 0
GWteB said:
Hi & welcome to MrExcel!

If object references are to be compared to each other, then the = operator doesn't fit and results in a run-time error. Instead the Is operator is needed.
So code like this
VBA Code: 
ElseIf rInt = Sheets("Data").Range("M3") Then
needs to be changed like this
VBA Code: 
ElseIf rInt Is Sheets("Data").Range("M3") Then

That said, none of the If statements will then evaluate to True since column N:N doesn't intersect with any of the cells involved in column M:M.

As I don't have insight in your data I'm not able to assist any further at this point.
Click to expand...
To be more specific on my desired intent:
Column N contains 3 options: Approved, Denied, "Blank"
If Approved or Denied (toggle lock cells A:M in row)

If "Blank" (toggle unlock)

In the event a row is approved or denied, the cells corresponding to the approval need locked. Need the ability to edit the row by setting cell to "blank"
 
Upvote 0
Here is the code I end up with that worked
VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WS As Worksheet
    
    Set WS = Worksheets("CL 2 Request")
    If WS.Cells(Target.Row, 14) = "Approved" Or WS.Cells(Target.Row, 14) = "Denied" Then
        Worksheets("CL 2 Request").Unprotect ("Secret")
            WS.Cells(Target.Row, 1).Locked = True
            WS.Cells(Target.Row, 2).Locked = True
            WS.Cells(Target.Row, 3).Locked = True
            WS.Cells(Target.Row, 4).Locked = True
            WS.Cells(Target.Row, 5).Locked = True
            WS.Cells(Target.Row, 6).Locked = True
            WS.Cells(Target.Row, 7).Locked = True
            WS.Cells(Target.Row, 8).Locked = True
            WS.Cells(Target.Row, 9).Locked = True
            WS.Cells(Target.Row, 10).Locked = True
            WS.Cells(Target.Row, 11).Locked = True
            WS.Cells(Target.Row, 12).Locked = True
            WS.Cells(Target.Row, 13).Locked = True
        Worksheets("CL 2 Request").Protect Password:="Secret", DrawingObjects:=False, contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
    ElseIf WS.Cells(Target.Row, 14) = "" Then
       Worksheets("CL 2 Request").Unprotect ("Secret")
            WS.Cells(Target.Row, 1).Locked = False
            WS.Cells(Target.Row, 2).Locked = False
            WS.Cells(Target.Row, 3).Locked = False
            WS.Cells(Target.Row, 4).Locked = False
            WS.Cells(Target.Row, 5).Locked = False
            WS.Cells(Target.Row, 6).Locked = False
            WS.Cells(Target.Row, 7).Locked = False
            WS.Cells(Target.Row, 8).Locked = False
            WS.Cells(Target.Row, 9).Locked = True
            WS.Cells(Target.Row, 10).Locked = False
            WS.Cells(Target.Row, 11).Locked = False
            WS.Cells(Target.Row, 12).Locked = False
            WS.Cells(Target.Row, 13).Locked = True
        Worksheets("CL 2 Request").Protect Password:="Secret", DrawingObjects:=False, contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
    End If
End Sub
 
Upvote 0
Solution
Glad it's sorted, well done!

Note that your code is executed in its entirety on every change, even if column N is not involved.
In this case this should not cause any problems. Nevertheless, you may still be interested in my delayed submission.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rInt   As Excel.Range
    Set rInt = Excel.Application.Intersect(Target, Me.Columns("N"))
    If Not rInt Is Nothing Then
        Me.Unprotect ("Secret")
        Dim c As Excel.Range, ChangeLock As Long
        For Each c In rInt
            ChangeLock = 0
            With c
                If .Value = "" Then
                    ChangeLock = 1
                ElseIf VBA.InStr(1, "*APPROVED*DENIED*", "*" & .Value & "*", vbTextCompare) > 0 Then
                    ChangeLock = -1
                End If
                If Not ChangeLock = 0 Then
                    .Resize(, .Column - 1).Offset(0, 1 - .Column).Locked = CBool(ChangeLock - 1)
                End If
            End With
        Next c
        Me.Protect Password:="Secret", DrawingObjects:=False, contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowSorting:=True, AllowFiltering:=True
    End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Solved
Macro Question
Replies
5
Views
310
Micron
M
S
  • Question
VBA Macro to add Header arrays and insert 2 rows
2
Replies
14
Views
753
slohman
S
F
  • Question
Returning changed dynamically created textbox value to corresponding cell
Replies
2
Views
335
frateg8r
F
ChristineJ
  • Solved
Adapting code to return cell values rather than cell references
Replies
2
Views
120
ChristineJ
ChristineJ
L
  • Locked
  • Question
Help with VBA code update
Replies
2
Views
371
Fluff
Fluff

Forum statistics

Threads
1,214,622
Messages
6,120,580
Members
448,972
Latest member
Shantanu2024

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