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

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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
241
Micron
M
M
  • Solved
Macro Question
Replies
5
Views
432
Micron
M
O
  • Question Question
Somewhat basic UDFs work except that they return #VALUE! error after hiding rows with VBA.
Replies
2
Views
111
OaklandJim
O
J
  • Question Question
Unprotect workbook, find certain RGB cells even if rows are deleted
Replies
1
Views
179
iliace
iliace
M
  • Solved
Help to exit VBA upon cancel on input box
Replies
3
Views
517
Domenic
D

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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