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

Repeat Last Command
Pressing F4 adds dollar signs when editing a formula. When not editing, F4 repeats last command.
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

O
  • Question Question
Frustrating intermittent VBA error dialog telling me that "User-define Type Not Defined"
Replies
1
Views
266
Micron
M
M
  • Solved
Macro Question
Replies
5
Views
438
Micron
M
M
  • Solved
Limit macro to certain cell range
Replies
3
Views
76
Joe4
Joe4
O
  • Question Question
Somewhat basic UDFs work except that they return #VALUE! error after hiding rows with VBA.
Replies
2
Views
129
OaklandJim
O
J
  • Question Question
Unprotect workbook, find certain RGB cells even if rows are deleted
Replies
1
Views
183
iliace
iliace

Forum statistics

Threads
1,224,823
Messages
6,181,184
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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