VBA and protected sheets

Golfpro1286

New Member
Joined
Aug 22, 2018
Messages
30
Hello, I have the following VBA code in a sheet that is giving me trouble when the sheet is protected: The original thread for this VBA and its purpose can be found at the bottom of this post.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim KyCell As Range
   If Target.CountLarge > 1 Then Exit Sub
   Set KyCell = Range("B225")
   On Error Resume Next
   Set KyCell = Union(KyCell, KyCell.Precedents)
   On Error GoTo 0
   If Not Intersect(Target, KyCell) Is Nothing Then
      If Me.CheckBox133.Value = True And Range("B225").Value >= 75000 Then
         MsgBox "Alert: This loan is for business purpose and exceeds $75M. A loan memo is required for the file."
         Sheets("Commercial Loan Memo").Visible = True
      End If
   End If
End Sub
The VBA works great, however it stops working when the sheet is protected. I protect the sheet so people can more easily tab between the fields that need to be filled in.

When protecting it I allow the following permissions:
Select Unlocked Cells
Format Cells
Format Columns
Format Rows
Edit Objects
Edit Scenarios

I have tried allowing all permissions and it still won't work while protected.

Cell B225 is locked so people cannot accidentally overwrite the formula.

Any help would be great. Thanks!


Original thread: https://www.mrexcel.com/forum/excel-questions/1104696-vba-message-box-help-2.html
 
Last edited:

Caleeco

Well-known Member
Joined
Jan 9, 2016
Messages
899
Hey,

You could just use VBA to unprotect the sheet whilst the code runs, and then protect it again once it's done. Untested, but something like this:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.Unprotect


   Dim KyCell As Range
   If Target.CountLarge > 1 Then Exit Sub
   Set KyCell = Range("B225")
   On Error Resume Next
   Set KyCell = Union(KyCell, KyCell.Precedents)
   On Error GoTo 0
   If Not Intersect(Target, KyCell) Is Nothing Then
      If Me.CheckBox133.Value = True And Range("B225").Value >= 75000 Then
         MsgBox "Alert: This loan is for business purpose and exceeds $75M. A loan memo is required for the file."
         Sheets("Commercial Loan Memo").Visible = True
      End If
   End If
   
    With ActiveSheet
        .Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
        .EnableSelection = xlUnlockedCells
    End With
End Sub
HTH
Caleeco
 

Golfpro1286

New Member
Joined
Aug 22, 2018
Messages
30
Hey,

You could just use VBA to unprotect the sheet whilst the code runs, and then protect it again once it's done. Untested, but something like this:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    ActiveSheet.Unprotect


   Dim KyCell As Range
   If Target.CountLarge > 1 Then Exit Sub
   Set KyCell = Range("B225")
   On Error Resume Next
   Set KyCell = Union(KyCell, KyCell.Precedents)
   On Error GoTo 0
   If Not Intersect(Target, KyCell) Is Nothing Then
      If Me.CheckBox133.Value = True And Range("B225").Value >= 75000 Then
         MsgBox "Alert: This loan is for business purpose and exceeds $75M. A loan memo is required for the file."
         Sheets("Commercial Loan Memo").Visible = True
      End If
   End If
   
    With ActiveSheet
        .Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
        .EnableSelection = xlUnlockedCells
    End With
End Sub
HTH
Caleeco
That worked perfectly, thank you!
 

Forum statistics

Threads
1,086,259
Messages
5,388,728
Members
402,137
Latest member
pkulkarni

Some videos you may like

This Week's Hot Topics

Top