how to protect sheets vba code

AYSHANA

Board Regular
Joined
Oct 16, 2021
Messages
90
Office Version
  1. 2019
  2. 2013
Platform
  1. Windows
good day
I would like to ask to to protect my sheet

I have tried to put ActiveSheet.protect ("1") but unfortunately, im getting a popup message ( the cell or chart you're trying to change is a protected sheet. To make a change unprotect the sheet. You might be requested to enter a password.)

thank you.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Result, Test As Range
Set Result = Range("N5")
ActiveSheet.Unprotect ("1")
Select Case Result
Case Is = "Reagent & Ortho Cards File": Rows("12:100").EntireRow.Hidden = True

Rows("7:11").EntireRow.Hidden = False
ActiveSheet.Protect ("1")

Case Is = "Validation File": Rows("7:11").EntireRow.Hidden = True

Rows("18:100").EntireRow.Hidden = True
Rows("12:17").EntireRow.Hidden = False

ActiveSheet.Protect ("1")
Case Is = "Antibody Workup & Transfusion Reaction Database": Rows("7:17").EntireRow.Hidden = True

Rows("24:100").EntireRow.Hidden = True
Rows("18:23").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "QC Files": Rows("7:23").EntireRow.Hidden = True

Rows("29:100").EntireRow.Hidden = True
Rows("24:28").EntireRow.Hidden = False
ActiveSheet.Protect ("1")



Case Is = "Received Blood Components": Rows("7:29").EntireRow.Hidden = True

Rows("35:100").EntireRow.Hidden = True
Rows("30:34").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "Equipment Calibration File": Rows("7:35").EntireRow.Hidden = True

Rows("48:100").EntireRow.Hidden = True
Rows("36:47").EntireRow.Hidden = False

ActiveSheet.Protect ("1")

Case Is = "COMARK File": Rows("7:48").EntireRow.Hidden = True

Rows("54:100").EntireRow.Hidden = True
Rows("49:53").EntireRow.Hidden = False


Case Is = "CAP Inspection File": Rows("7:54").EntireRow.Hidden = True

Rows("60:100").EntireRow.Hidden = True
Rows("55:59").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "BB Soft Copy Files": Rows("7:60").EntireRow.Hidden = True

Rows("71:100").EntireRow.Hidden = True
Rows("61:70").EntireRow.Hidden = False

ActiveSheet.Protect ("1")

Case Is = "KPI Files": Rows("7:71").EntireRow.Hidden = True

Rows("75:100").EntireRow.Hidden = True
Rows("72:74").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "Temperatuer Files": Rows("7:75").EntireRow.Hidden = True

Rows("80:100").EntireRow.Hidden = True
Rows("76:79").EntireRow.Hidden = False

ActiveSheet.Protect ("1")


Case Is = "Administrative Files": Rows("7:80").EntireRow.Hidden = True

Rows("88:100").EntireRow.Hidden = True
Rows("81:87").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


End Select


End Sub
 
Is your sheet unprotecting when you do it manually with 1 as the password?
and we still need to know what line of the code is causing the error
yes if ill put the password it will unprotect and will allow me to change, but then ill not be able to change it will ask for password again.

and regarding error how can i know which line is causing an error. because it is not showing any error :(
 
Upvote 0

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Is your sheet unprotecting when you do it manually with 1 as the password?
and we still need to know what line of the code is causing the error
yes if ill put the password it will unprotect and will allow me to change, but then ill not be able to change it will ask for password again.

and regarding how can i know which line is causing an error. because it is not showing any error :(
 
Upvote 0
and regarding error how can i know which line is causing an error. because it is not showing any error :(
No line is turning yellow and you don't have the option to debug?

If not put the word Stop as per the below, then step through the code with F8 until it stops you again

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Result, Test As Range
Stop
Set Result = Range("N5")
ActiveSheet.Unprotect ("1")

Also try the lines below in red as I think the code is re-triggering itself
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Result, Test As Range
    Set Result = Range("N5")
    ActiveSheet.Unprotect "1"

   Application.EnableEvents = False

    Select Case Result
    Case Is = "Reagent & Ortho Cards File": Rows("12:100").EntireRow.Hidden = True

        Rows("7:11").EntireRow.Hidden = False
   


    Case Is = "Validation File": Rows("7:11").EntireRow.Hidden = True

        Rows("18:100").EntireRow.Hidden = True
        Rows("12:17").EntireRow.Hidden = False
    
    
    Case Is = "Antibody Workup & Transfusion Reaction Database": Rows("7:17").EntireRow.Hidden = True

        Rows("24:100").EntireRow.Hidden = True
        Rows("18:23").EntireRow.Hidden = False


    Case Is = "QC Files": Rows("7:23").EntireRow.Hidden = True

        Rows("29:100").EntireRow.Hidden = True
        Rows("24:28").EntireRow.Hidden = False



    Case Is = "Received Blood Components": Rows("7:29").EntireRow.Hidden = True

        Rows("35:100").EntireRow.Hidden = True
        Rows("30:34").EntireRow.Hidden = False


    Case Is = "Equipment Calibration File": Rows("7:35").EntireRow.Hidden = True

        Rows("48:100").EntireRow.Hidden = True
        Rows("36:47").EntireRow.Hidden = False

    Case Is = "COMARK File": Rows("7:48").EntireRow.Hidden = True

        Rows("54:100").EntireRow.Hidden = True
        Rows("49:53").EntireRow.Hidden = False


    Case Is = "CAP Inspection File": Rows("7:54").EntireRow.Hidden = True

        Rows("60:100").EntireRow.Hidden = True
        Rows("55:59").EntireRow.Hidden = False


    Case Is = "BB Soft Copy Files": Rows("7:60").EntireRow.Hidden = True

        Rows("71:100").EntireRow.Hidden = True
        Rows("61:70").EntireRow.Hidden = False



    Case Is = "KPI Files": Rows("7:71").EntireRow.Hidden = True

        Rows("75:100").EntireRow.Hidden = True
        Rows("72:74").EntireRow.Hidden = False


    Case Is = "Temperatuer Files": Rows("7:75").EntireRow.Hidden = True

        Rows("80:100").EntireRow.Hidden = True
        Rows("76:79").EntireRow.Hidden = False



    Case Is = "Administrative Files": Rows("7:80").EntireRow.Hidden = True

        Rows("88:100").EntireRow.Hidden = True
        Rows("81:87").EntireRow.Hidden = False



    End Select

    ActiveSheet.Protect "1"

    Application.EnableEvents = True

End Sub
 
Upvote 0
The "error" message you display is not triggered by VBA! If you would use VBA to try to change the content of a cell on a protected worksheet, you would get a dialog like this:
1696258203289.png
 
Upvote 1
No line is turning yellow and you don't have the option to debug?

If not put the word Stop as per the below, then step through the code with F8 until it stops you again

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Result, Test As Range
Stop
Set Result = Range("N5")
ActiveSheet.Unprotect ("1")

Also try the lines below in red as I think the code is re-triggering itself
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Result, Test As Range
    Set Result = Range("N5")
    ActiveSheet.Unprotect "1"

   Application.EnableEvents = False

    Select Case Result
    Case Is = "Reagent & Ortho Cards File": Rows("12:100").EntireRow.Hidden = True

        Rows("7:11").EntireRow.Hidden = False
  


    Case Is = "Validation File": Rows("7:11").EntireRow.Hidden = True

        Rows("18:100").EntireRow.Hidden = True
        Rows("12:17").EntireRow.Hidden = False
   
   
    Case Is = "Antibody Workup & Transfusion Reaction Database": Rows("7:17").EntireRow.Hidden = True

        Rows("24:100").EntireRow.Hidden = True
        Rows("18:23").EntireRow.Hidden = False


    Case Is = "QC Files": Rows("7:23").EntireRow.Hidden = True

        Rows("29:100").EntireRow.Hidden = True
        Rows("24:28").EntireRow.Hidden = False



    Case Is = "Received Blood Components": Rows("7:29").EntireRow.Hidden = True

        Rows("35:100").EntireRow.Hidden = True
        Rows("30:34").EntireRow.Hidden = False


    Case Is = "Equipment Calibration File": Rows("7:35").EntireRow.Hidden = True

        Rows("48:100").EntireRow.Hidden = True
        Rows("36:47").EntireRow.Hidden = False

    Case Is = "COMARK File": Rows("7:48").EntireRow.Hidden = True

        Rows("54:100").EntireRow.Hidden = True
        Rows("49:53").EntireRow.Hidden = False


    Case Is = "CAP Inspection File": Rows("7:54").EntireRow.Hidden = True

        Rows("60:100").EntireRow.Hidden = True
        Rows("55:59").EntireRow.Hidden = False


    Case Is = "BB Soft Copy Files": Rows("7:60").EntireRow.Hidden = True

        Rows("71:100").EntireRow.Hidden = True
        Rows("61:70").EntireRow.Hidden = False



    Case Is = "KPI Files": Rows("7:71").EntireRow.Hidden = True

        Rows("75:100").EntireRow.Hidden = True
        Rows("72:74").EntireRow.Hidden = False


    Case Is = "Temperatuer Files": Rows("7:75").EntireRow.Hidden = True

        Rows("80:100").EntireRow.Hidden = True
        Rows("76:79").EntireRow.Hidden = False



    Case Is = "Administrative Files": Rows("7:80").EntireRow.Hidden = True

        Rows("88:100").EntireRow.Hidden = True
        Rows("81:87").EntireRow.Hidden = False



    End Select

    ActiveSheet.Protect "1"

    Application.EnableEvents = True

End Sub
no nothing is turinig in to yellow, even the debug option is not there.
ok ill try
 
Upvote 0
No line is turning yellow and you don't have the option to debug?

If not put the word Stop as per the below, then step through the code with F8 until it stops you again

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Result, Test As Range
Stop
Set Result = Range("N5")
ActiveSheet.Unprotect ("1")

Also try the lines below in red as I think the code is re-triggering itself
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Result, Test As Range
    Set Result = Range("N5")
    ActiveSheet.Unprotect "1"

   Application.EnableEvents = False

    Select Case Result
    Case Is = "Reagent & Ortho Cards File": Rows("12:100").EntireRow.Hidden = True

        Rows("7:11").EntireRow.Hidden = False
  


    Case Is = "Validation File": Rows("7:11").EntireRow.Hidden = True

        Rows("18:100").EntireRow.Hidden = True
        Rows("12:17").EntireRow.Hidden = False
   
   
    Case Is = "Antibody Workup & Transfusion Reaction Database": Rows("7:17").EntireRow.Hidden = True

        Rows("24:100").EntireRow.Hidden = True
        Rows("18:23").EntireRow.Hidden = False


    Case Is = "QC Files": Rows("7:23").EntireRow.Hidden = True

        Rows("29:100").EntireRow.Hidden = True
        Rows("24:28").EntireRow.Hidden = False



    Case Is = "Received Blood Components": Rows("7:29").EntireRow.Hidden = True

        Rows("35:100").EntireRow.Hidden = True
        Rows("30:34").EntireRow.Hidden = False


    Case Is = "Equipment Calibration File": Rows("7:35").EntireRow.Hidden = True

        Rows("48:100").EntireRow.Hidden = True
        Rows("36:47").EntireRow.Hidden = False

    Case Is = "COMARK File": Rows("7:48").EntireRow.Hidden = True

        Rows("54:100").EntireRow.Hidden = True
        Rows("49:53").EntireRow.Hidden = False


    Case Is = "CAP Inspection File": Rows("7:54").EntireRow.Hidden = True

        Rows("60:100").EntireRow.Hidden = True
        Rows("55:59").EntireRow.Hidden = False


    Case Is = "BB Soft Copy Files": Rows("7:60").EntireRow.Hidden = True

        Rows("71:100").EntireRow.Hidden = True
        Rows("61:70").EntireRow.Hidden = False



    Case Is = "KPI Files": Rows("7:71").EntireRow.Hidden = True

        Rows("75:100").EntireRow.Hidden = True
        Rows("72:74").EntireRow.Hidden = False


    Case Is = "Temperatuer Files": Rows("7:75").EntireRow.Hidden = True

        Rows("80:100").EntireRow.Hidden = True
        Rows("76:79").EntireRow.Hidden = False



    Case Is = "Administrative Files": Rows("7:80").EntireRow.Hidden = True

        Rows("88:100").EntireRow.Hidden = True
        Rows("81:87").EntireRow.Hidden = False



    End Select

    ActiveSheet.Protect "1"

    Application.EnableEvents = True

End Sub
it didnt work
 
Upvote 0
it didnt work
It won't, see below.....

yes if ill put the password it will unprotect and will allow me to change, but then ill not be able to change it will ask for password again.
The "error" message you display is not triggered by VBA! If you would use VBA to try to change the content of a cell on a protected worksheet, you would get a dialog like this:
no nothing is turinig in to yellow, even the debug option is not there.



@AYSHANA that all says to me that the sheet is telling you it is protected before you try changing a cell to trigger the code, you do have unlocked cells on your sheet don't you to allow your initial entry?

P.S. as per @jkpieterse that error message is the same as when I manually try entering in a locked cell on a protected sheet
1696258859695.png
 
Upvote 0
Solution
It won't, see below.....







@AYSHANA that all says to me that the sheet is telling you it is protected before you try changing a cell to trigger the code, you do have unlocked cells on your sheet don't you to allow your initial entry?

P.S. as per @jkpieterse that error message is the same as when I manually try entering in a locked cell on a protected sheet
View attachment 99597
yes
I got it
it is working now
thanks, a lot 🌹
 
Upvote 0
Glad you have it sorted, happy we could help
 
Upvote 1
good day
I would like to ask to to protect my sheet

I have tried to put ActiveSheet.protect ("1") but unfortunately, im getting a popup message ( the cell or chart you're trying to change is a protected sheet. To make a change unprotect the sheet. You might be requested to enter a password.)

thank you.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Result, Test As Range
Set Result = Range("N5")
ActiveSheet.Unprotect ("1")
Select Case Result
Case Is = "Reagent & Ortho Cards File": Rows("12:100").EntireRow.Hidden = True

Rows("7:11").EntireRow.Hidden = False
ActiveSheet.Protect ("1")

Case Is = "Validation File": Rows("7:11").EntireRow.Hidden = True

Rows("18:100").EntireRow.Hidden = True
Rows("12:17").EntireRow.Hidden = False

ActiveSheet.Protect ("1")
Case Is = "Antibody Workup & Transfusion Reaction Database": Rows("7:17").EntireRow.Hidden = True

Rows("24:100").EntireRow.Hidden = True
Rows("18:23").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "QC Files": Rows("7:23").EntireRow.Hidden = True

Rows("29:100").EntireRow.Hidden = True
Rows("24:28").EntireRow.Hidden = False
ActiveSheet.Protect ("1")



Case Is = "Received Blood Components": Rows("7:29").EntireRow.Hidden = True

Rows("35:100").EntireRow.Hidden = True
Rows("30:34").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "Equipment Calibration File": Rows("7:35").EntireRow.Hidden = True

Rows("48:100").EntireRow.Hidden = True
Rows("36:47").EntireRow.Hidden = False

ActiveSheet.Protect ("1")

Case Is = "COMARK File": Rows("7:48").EntireRow.Hidden = True

Rows("54:100").EntireRow.Hidden = True
Rows("49:53").EntireRow.Hidden = False


Case Is = "CAP Inspection File": Rows("7:54").EntireRow.Hidden = True

Rows("60:100").EntireRow.Hidden = True
Rows("55:59").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "BB Soft Copy Files": Rows("7:60").EntireRow.Hidden = True

Rows("71:100").EntireRow.Hidden = True
Rows("61:70").EntireRow.Hidden = False

ActiveSheet.Protect ("1")

Case Is = "KPI Files": Rows("7:71").EntireRow.Hidden = True

Rows("75:100").EntireRow.Hidden = True
Rows("72:74").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


Case Is = "Temperatuer Files": Rows("7:75").EntireRow.Hidden = True

Rows("80:100").EntireRow.Hidden = True
Rows("76:79").EntireRow.Hidden = False

ActiveSheet.Protect ("1")


Case Is = "Administrative Files": Rows("7:80").EntireRow.Hidden = True

Rows("88:100").EntireRow.Hidden = True
Rows("81:87").EntireRow.Hidden = False
ActiveSheet.Protect ("1")


End Select


End Sub
HI,

For me the below works fine fine, used at the begiining and the end of your sub.

VBA Code:
ActiveSheet.Unprotect Password:="Use Your Password Here"
ActiveSheet.Protect Password:="Use Your Password Here"

Example below
VBA Code:
Private Sub RevealCharges_Click()
    ActiveSheet.Unprotect Password:="Use Your Password Here"
    If Range("M29") = False Then Rows("33:76").EntireRow.Hidden = True
    If Range("M29") = True Then Rows("33:76").EntireRow.Hidden = False
    ActiveSheet.Protect Password:="Use Your Password Here", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,885
Messages
6,175,183
Members
452,615
Latest member
bogeys2birdies

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