Protect/Unprotect Sheets Macro

[burns14hs]

Hello All -

I have a workbook with 35 sheets on a shared drive at work. Recently someone deleted things they weren't supposed to and all hell broke loose. After unlocking all the cells the user should be using I would like to find a code that does the following if possible:

1. Protects all sheets automatically on open with the same password regardless of the status of those sheets the last time they were exited.
2. If the person in charge of maintaining the file unprotects a sheet with a correct password, automatically unprotect all sheets in the workbook.

I believe the below code should protect the sheets on open if I make an original With statement for each sheet and still allow users to be able to access the group/ungroup buttons. Am I correct here for item 1 on the list, or am I off on something?

Private Sub Workbook_Open()
With Sheet1
.Protect Password:="password", UserInterfaceOnly:=True
.EnableOutlining = True
End With
End Sub
#2 on the list I'm completely lost on, however. Any help here would be most appreciated.

 

[Urtehnoes]

Hello!
#2 is awesome and simple with Environ.

sub Workbook open ()
Dim PassStr as String
Dim Login as string
dim sht as worksheet
dim book as workbook
set book= activeworkbook
for each sht in book
.protect password:= "Password1"
' you can set rules above as far as what can or can't be edited
next sht


PassStr = "burns14hs"
Login = Environ("Username")

If StrComp(PassStr, Login)=0 then
.Unprotect code etc
else
Msgbox "Don't break my spreadsheet!!!"
end if

endsub

environ("username") returns the computer login I was so happy when I discovered that, as I have coworkers who get into my books all the time.

pardon typos, in car repair shop with iPad and it's terrible at code

 

[burns14hs]

I'm sorry but this isn't working and I'm not experienced enough with VBA to figure out what means what to even begin troubleshooting For starters, I'm not sure what ".Unprotect code etc" should be at all. Sorry, I'm relatively new to VBA and macros

Also, is "PassStr = "burns14hs"" saying that "burns14hs" is a username that will unprotect the sheet?

 

[Urtehnoes]

I'm sorry but this isn't working and I'm not experienced enough with VBA to figure out what means what to even begin troubleshooting For starters, I'm not sure what ".Unprotect code etc" should be at all. Sorry, I'm relatively new to VBA and macros

Also, is "PassStr = "burns14hs"" saying that "burns14hs" is a username that will unprotect the sheet?

Sorry! I know it was vague. I'm running errands so I posted that from my phone... I'll see if I can get you actual code in... Hopefully less than 30 minutes.

 

[burns14hs]

Thanks a bunch... I've been spending some time proving through trial and error how little I know about what I'm doing

 

[burns14hs]

Also if you can help with the following, that would be great as well... After I add the code that protects the worksheets on open, I need to add VBA that forces the user to enable macros before continuing. I have some code that works, but it runs on workbook close and always includes a save. I want the user to be able to exit without saving in case they make a mistake that they don't want saved for some reason. If I change the macro to run on save but the user saves without exiting, it puts the front sheet up again and points them to the yellow "enable macros" notification that is only there upon first entering the workbook and isn't there now. Is there a vba way to redisplay the enable macros notification automatically after each save? The VBA is below:


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Application.ScreenUpdating = False

'Step 1: Declare your variables
Dim ws As Worksheet

'Step 2: Unhide the Starting Sheet
Sheets("START").Visible = xlSheetVisible

'Step 3: Start looping through all worksheets
For Each ws In ThisWorkbook.Worksheets

'Step 4: Check each worksheet name
If ws.Name <> "START" Then

'Step 5: Hide the sheet
ws.Visible = xlVeryHidden
End If

'Step 6: Loop to next worksheet
Next ws

Application.ScreenUpdating = True

End Sub


Private Sub Workbook_Open()

'Temporarily Disable Screen Updating
Application.ScreenUpdating = False

'Step 1: Declare your variables
Dim ws As Worksheet

'Step 2: Start looping through all worksheets
For Each ws In ThisWorkbook.Worksheets

'Step 3: Unhide All Worksheets
ws.Visible = xlSheetVisible

'Step 4: Loop to next worksheet
Next ws

'Step 5: Very Hide the Start Sheet
Sheets("START").Visible = xlVeryHidden
'Step 6: Hide All Unnecessary Sheets
Sheets("YOY Fill Rate By Category").Visible = x1SheetHidden
Sheets("Fill Rate By Category").Visible = x1SheetHidden
Sheets("Fill Rate By Store").Visible = x1SheetHidden
Sheets("Supply Matrix").Visible = x1SheetHidden
Sheets("New Store Category Needs").Visible = x1SheetHidden
Sheets("2020").Visible = x1SheetHidden
Sheets("2019").Visible = x1SheetHidden
Sheets("2018").Visible = x1SheetHidden
Sheets("2017").Visible = x1SheetHidden
Sheets("2016").Visible = x1SheetHidden
Sheets("2015").Visible = x1SheetHidden
Sheets("Beginning On Hand").Visible = x1SheetHidden
Sheets("ValidationLists").Visible = x1SheetHidden

'Step 7: Select Cursor Position on Start
Sheets("2014").Activate
Range("A1").Select

'Re-Activate Screen Update
Application.ScreenUpdating = True

End Sub

 

[burns14hs]

Nevermind the above question, I solved it by attaching my workbook open sub to a macro button....

 

[Urtehnoes]

Nevermind the above question, I solved it by attaching my workbook open sub to a macro button....

Great!

The first macro below is what I was originally referring to, by allowing only you to have access to your sheets. Just be sure to update the Pword variable with your login before running it the first time..


And wow, this turned out to be a bigger doozy than I thought... The EnableOutlining = True won't really let you do what you want to do.

I've researched this myself, and the only way I can possibly think of is below. What you'll need to do is add a button (to ribbon/toolbar/worksheet) assign the GroupColumns Macro to said button.

The GroupColumns Macro will ask them if they want to group or ungroup (there's no way to test if the selection is currently grouped), and then test to ensure they have only an entire column, or entire row selected, and if so.... will group/ungroup it.



You'd really think Microsoft would allow features like these to be more... accessible.

Private Sub Workbook_Open()
Dim i As Long
Dim WkBk As Workbook
Dim Login As String
Dim PWord As String
Dim AdminAccess As Boolean


Set WkBk = ActiveWorkbook


'Environ("UserName") grabs the login name attached to your profile on your computer.
Login = Environ("UserName")
PWord = "ENTER YOUR NETWORK/COMPUTER LOGIN (NOT PASS) HERE"


If StrComp(Login, PWord) = 0 Then AdminAccess = True


For i = 1 To WkBk.Sheets.Count
    If AdminAccess = False Then
        Sheets(i).Protect Password:=PWord, UserInterfaceOnly:=True
    Else
        Sheets(i).Unprotect Password:=PWord
    End If
Next i


End Sub


Sub GroupColumns()


Dim Target As Range
Dim TargetAddress As String
Dim StartPoint As Long
Dim ChkAddress() As String
Dim TestAddress As String
Dim SwitchRefStyle As Boolean
Dim i As Long
Dim RetVal As Long


RetVal = MsgBox("Do you wish to GROUP this selection?" & vbCrLf & "Press YES to Group, or NO to UNGROUP", vbYesNoCancel, "Grouping Selection")


If Application.ReferenceStyle = xlR1C1 Then
    Application.ReferenceStyle = xlA1
    SwitchRefStyle = True
End If


Set Target = Selection
TargetAddress = Target.Address
ChkAddress = Split(TargetAddress, ":")


'Given that Target.Address = $A:$G (or) $3343:$2444 if the EntireRow OR EntireColumn are selected


StartPoint = InStr(ChkAddress(0), "$")
TestAddress = ChkAddress(0)
TestAddress = Right(TestAddress, Len(TestAddress) - 1)


If IsNumeric(TestAddress) = True Then
    'This means we have an entire row ONLY selected, so let's group or Ungroup it!
Else
    'This is a bit more tricky, as "A34" is a string, just as "BA" is a string, so we'll cut it up and see (IsNumeric should never be true going forward:)
    For i = StartPoint To Len(TestAddress)
        If IsNumeric(Mid(TestAddress, i, 1)) = True Then Exit Sub
    Next i
    'If we've gotten to this line, then this means we have an entire column ONLY selected.
End If


'This is where the MsgBox answer from before comes into play - if we chose 'yes', then we group, if 'no', then we ungroup, cancel then we exit sub
'On the off chance the user does have R1C1 Referencing turned on, we turned it off for the macro, so we'll turn it back on now.
Select Case RetVal


Case vbYes
    If SwitchRefStyle = True Then Application.ReferenceStyle = xlR1C1
    Selection.Group
Case vbNo
    If SwitchRefStyle = True Then Application.ReferenceStyle = xlR1C1
    Selection.Ungroup
Case vbCancel
    If SwitchRefStyle = True Then Application.ReferenceStyle = xlR1C1
End Select
End Sub

 

[burns14hs]

The username part works magically, I have yet to test out the GroupColumns sub because I didn't wanna test too much stuff at once. I can't even begin to find enough words to thank you! One final question, however... if I want to give access to 2 users (myself and 1 other) do I need to incorporate an Or statement after PWord =?

 

[UWMmakow]

PWord1…. PWord2….

xD