Worksheet.Protect does not always apply the password - vba

On Excel 2016, I would like to add a button in the Quick Access Toolbar that will toggle Protect/Unprotect the active worksheet, using always the same password.
I created an xlam file containing the following macro:
Sub Protection()
If ActiveSheet.ProtectContents Then
ActiveSheet.Unprotect Password:="TEST"
Else
ActiveSheet.Protect Password:="TEST"
End If
End Sub
It seems to work fine at first.
But when I do the following:
Protect using the regular Excel ribbon button with no password
Unprotect using the macro (it works even if no password is required and I think that's where the problem is)
Protect using the macro
Unprotect using the regular Excel button: No password is requested!!!
The following code seems to do the trick:
Sub Protection()
On Error Resume Next
If ActiveSheet.ProtectContents Then
ActiveSheet.Unprotect Password:=""
If Err.Number <> 0 Then
ActiveSheet.Unprotect Password:="TEST"
If Err.Number <> 0 Then
MsgBox ("The password is not the usual one.")
End If
End If
Else
ActiveSheet.Protect Password:="TEST"
End If
On Error GoTo 0
End Sub
However, it doesn't seem clean.
I have this problem on my work computer (Excel 2016) but it seems OK on my personal computer (Excel 365).
Is there a better way to make sure the correct protection is applied, whatever the user has done previously on the file?

Related

excel created a password to unprotect a sheet without me telling it to

I have a protected sheet with certain cells unlocked for editing. I have button click macros that run various processes that temporarily unprotect the sheet to allow the code to run, then protect it again when done. example:
sub macro1()
activesheet.unprotect
' code here
activesheet.protect allowsorting = true
activesheet.protect allowfilter:= true
end sub
for some reason when I run these macros now, it is asking for a password that I never put in there. the sheet should not be password protected. I ran a password breaker macro and it told me the password is "AAAAAAAABABF"
what would cause this, and how to I remove it from asking for a password?
can't seem to find any results in the forum with this issue.
thanks for your help
You have an error in the code, thus the password protection gets activated on this line activesheet.protect allowsorting = true. To avoid errors like this one, make sure that you always use Option Explicit on the top.
In general, this should be ok:
Sub Macro1()
ActiveSheet.Unprotect
'code
ActiveSheet.Protect AllowSorting:=True
ActiveSheet.Protect AllowFiltering:=True
End Sub
Concerning the AAAAAAAABABF, it is not the password you have set, but its hashed value is the same as the hashed value of your password.
If you want to see yourself, try just this code:
Sub TestMe
ActiveSheet.Unprotect AllowSorting = True
End Sub
It is a bit meaningless, but as far as you have used "AllowSorting = True" as a password, you can use it for the unprotect.

Hide a worksheet based on username

I already have a macro below that un-hides a worksheet at the click of a button and works okay. However I want this macro to be changed so that ONLY two users (whose usernames are "JSMITH" AND "DTAYLOR") are able to unhide this sheet called "Rates".
If someone else (whose username is not one of the two mentioned above) tries to unhide the sheet, I want Excel to display a message "you're not authorised to open this".
Moreover, I need to make sure that only those two users are able to un-hide in a traditional way without vba (eg by right-clicking on a visible worksheet tab and choose Unhide or from any worksheet tab, choose Format, Sheet, and then Unhide).
Can you please advise how to modify the following code to do the all the things described above?
Sub Hide_AllRatesSheet()
Worksheets("Rates").Visible = False
ThisWorkbook.Sheets("Names").Activate
End Sub
Note: you could use xlSheetVeryHidden property to allow unhiding it only from code (and not by mouse right-click).
Try something like the code below:
Sub Hide_AllRatesSheet()
Select Case Environ$("username") '<-- check username
Case "JSMITH", "DTAYLOR"
If ActiveSheet.Name <> "Rates" Then '<-- make sure "Rates" is not the ActiveSheet
Worksheets("Rates").Visible = False
Else
ThisWorkbook.Sheets("Names").Activate
Worksheets("Rates").Visible = False
End If
Case Else
MsgBox "you're not authorised to open this"
End Select
End Sub

Close a workbook at a specific time

I have looked everywhere to get an answer to this and can't figure it out. I'm looking for a way to close and save a workbook automatically at midnight every night because it has important information that people keep losing because they don't save it. I've got the closing and saving part down, if I manually click the X to close Excel, but I can't get it to do it at a predetermined time. I've used Application.OnTime without any success. Here is the code that I'm using to close and save the workbook. I just need the code to have it run at midnight if the workbook is still open.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheet1.Activate
Sheet1.Range("AB18:AD18").Select
Selection.ClearContents
ActiveWorkbook.Save
End Sub
I had trouble referencing the Worksheet .CodeName property but not with the Worksheet .Name property.
Module1 code sheet
Option Explicit
Sub ScheduleClose()
Application.OnTime Now + TimeSerial(0, 0, 4), "Kamikaze"
End Sub
Sub Kamikaze()
Debug.Print "boom"
Application.DisplayAlerts = False
With ThisWorkbook
.Worksheets("Sheet1").Activate
.Worksheets("Sheet1").Range("AB18:AD18").ClearContents
.Save
.Close savechanges:=False
End With
End Sub
Of course, the workbook must be already saved (i.e. not Book1) since no name is provided but a Workbook.SaveAs method could be used if the workbook habitually is not already saved.
This will also leave 'orphaned' VBA projects within the Excel application 'instance'. VBA cannot kill itself as it has to be running to complete the command.

Why does this code work with F1 and not CTRL-M (for example)

I found this code online, and it works like a charm:
Sub Auto_Open()
Application.OnKey "{F1}", "WorkbooksHandler"
End Sub
Sub WorkbooksHandler()
On Error Resume Next
If ActiveWorkbook.Sheets.Count <= 16 Then
Application.CommandBars("Workbook Tabs"). _
ShowPopup 500, 225
Else
Application.CommandBars("Workbook Tabs"). _
Controls("More Sheets...").Execute
End If
On Error GoTo 0
End Sub
I press F1 and it opens a dialogue with all the sheets. I can select the sheet I want and it goes there.
If I change the code just slightly, and use:
Sub Auto_Open()
Application.OnKey "^{m}", "WorkbooksHandler"
End Sub
Now control-m opens with dialogue showing me the sheets, but when I click on the sheet I want excel doesn't navigate there. Why should the trigger make any difference, and make the execution not work?
Edit: By the way, the code also works fine when I run it manually with F5 as well, just not with the onkey control-m.
The problem appears to be that the Control key, when used with OnKey persists through the whole command even though you've no doubt released the key. This has no effect on most things that you do, but inexplicably effects the More Sheets popup. Take this code
Sub Auto_Open()
Application.OnKey "^m", "WorkbooksHandler"
End Sub
Sub WorkbooksHandler()
SendKeys "{RIGHT}"
End Sub
All that does is press the right arrow key. But it has the effect of pressing Ctrl+Right which takes you to the edge of you worksheet (for a blank worksheet). So the Control part of ^m is sticking around through the execution of WorkbooksHandler.
This happens manually also. Hold down the control key, right click on the sheet navigation buttons, select More Sheets, select a sheet. It doesn't move to that sheet when you have Control held down.
I tried all manner of SendKeys, OnTime, and DoEvents, but couldn't trick Excel into releasing the Control key. I'll bet you could find a Windows API that would do the trick, but it's probably easier to simply pick a key combination that doesn't use Control.
Make sure
Sub WorkbooksHandler()
On Error Resume Next
If ActiveWorkbook.Sheets.Count <= 16 Then
Application.CommandBars("Workbook Tabs"). _
ShowPopup 500, 225
Else
Application.CommandBars("Workbook Tabs"). _
Controls("More Sheets...").Execute
End If
On Error GoTo 0
End Sub
is pasted in Modules,
Then
Compile and Run the Auto_Open() manually then try the shortcut

VBA to protect an Excel sheet but allow sort, autofilter, charts, copy

My workbook consists of almost 25 sheets, I want to protect 11 sheets. My criteria for protecting are as follows:
1. User cannot delete or modify any cell
2. User should be able to use SORT, AUTOFILTER, drop down selection from COMBO BOXES
3. Most of the sheets contain charts, they should be updated as per the user selection
4. User should not be able to see the formulas in the formula bar
5. User should be able to copy the data
I have tried all the general options in Excel, which does all the above work, but they leave the cells unlocked, which means user can delete the contents
Thus I hope this can be achieved only by a macro, please help.
I have tried all the general options in Excel, which does all the above work, but they leave the cells unlocked, which means user can delete the contents
Since every thing else works for you, I will not try to address those. With already what you have, add this code in the worksheet code area
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Dim rng As Range
Application.EnableEvents = False
For Each rng In Target
If rng.Value = "" Then
Application.Undo
Exit For
End If
Next
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub