I am using the code below to protect and save the workbook automatically upon closing. However, this code isn't allowing me to use the group / ungroup feature when I re-open the workbook. Can I edit this code to allow the group / ungroup?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:="your password", UserInterfaceOnly:=True, AllowFormattingColumns:=True
ws.EnableOutlining = True
Next ws
ThisWorkbook.Protect "your password", True
ThisWorkbook.Save
End Sub
I tried using the code below to allow the Group/Ungroup on opening, but it doesn't work the way I intended. I had to insert a button into the worksheet. The code does work with the use of a button. I was hoping for one automatic code to solve the group/ungroup problem which doesn't use a button.
Sub Workbook_Open()
For Each ws In Sheets
With ws
.Unprotect Password:="your password"
.Protect Password:="your password", UserInterfaceOnly:=True
.EnableOutlining = True
End With
Next ws
End Sub
Related
I don't know very much at all about VBA, but I found the below code on a website and am using it in a workbook.
Private Sub Workbook_Open()
With Worksheets("WFD")
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
End Sub
How should I amend this so that if the Sheet name is changed from "WFD" to something else, the code still works? Also I would like it to apply to all sheets in the workbook.
Thanks very much
If you want this code for each worksheet use code below:
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
With ws
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
Next
End Sub
You should use the Sheet Object Codename.
This is found in the VB Editor beside the sheet objects in the VB project.
By default they are Sheet1, Sheet2 etc. You can easily change them by clicking and typing a new name etc.
You could of course leave them as default codeName if you like...
This is NOT the same as the worksheet name, which is changed by users on the Sheet tabs in Excel interface.
Private Sub Workbook_Open()
With WFD 'where WFD is the CODENAME of the Sheet Object!
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
End Sub
You could write Worksheets(1) or Worksheets(5), depending on the number of the Worksheet. However, if you start adding and deleting Worksheets, it whould not work (e.g., it would be working on some other worksheet). To see the associated number to the worksheet, run this and check the immediate window:
Option Explicit
Public Sub TestMe()
Dim ws As Worksheet
Dim cnt As Long
For cnt = 1 To ThisWorkbook.Worksheets.Count
Debug.Print cnt; "-> "; Worksheets(cnt).name
Next cnt
End Sub
However, if you have only one Worksheet, Worksheets(1) would always work.
I am very new to VBA and have basically taught myself while building my current Excel 'contract'. My goal is have a list of contract options which are shown or hidden depending on their representative check boxes. There are 12 total options with ranges that I show/remove across 4 worksheets.
In terms of organization, I have utilized modules based on each action. I also named all my ranges
Prior to me protecting my worksheet, when I select a checkbox, all 4 ranges across all 4 worksheets immediately show. When I unselect, they immediately clear their contents and hide. Yay!
Once I protect my worksheet, however, things either slow down to a crawl or I get an error. In my ProtectWorksheet module below, the commented out lines work, but from reading other stack overflow articles it seens better to use the code I have. Unprotected, it works great. Protected I get the "Error 1004': Unable to set the Hidden property of the Range class". If I instead use my commented out code while protected, it works but is super slow.
Technically I can get everything to work...but from a user interface stance it's terrible.
Below is the 1st contract option I have been testing. Please and thank you for any and all help!
under the Excel Objects - sheet2(Data Input)
Private Sub chkDomesticHotWater_Click()
ProtectOFF
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If chkDomesticHotWater = True Then
AddDomesticHotWater
Else
'Remove the lines, clear the data, and move the mouse to the top
RemoveDomesticHotWater
ClearDomesticHotWater
Range("A1").Select
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ProtectON
End Sub
under the Module: Checkboxes
Sub AddDomesticHotWater()
[DataInput_DomesticHotWater].EntireRow.Hidden = False
[Contract_DomesticHotWater].EntireRow.Hidden = False
[Invoice_DomesticHotWater].EntireRow.Hidden = False
[ExpectedCost_DomesticHotWater].EntireRow.Hidden = False
End Sub
Sub RemoveDomesticHotWater()
[DataInput_DomesticHotWater].EntireRow.Hidden = True
[Contract_DomesticHotWater].EntireRow.Hidden = True
[Invoice_DomesticHotWater].EntireRow.Hidden = True
[ExpectedCost_DomesticHotWater].EntireRow.Hidden = True
End Sub
Under the Module ClearData
Sub ClearDomesticHotWater()
Range("DataInput_DomesticHotWater").Select
For Each cell In Selection
If cell.Interior.Color = RGB(226, 239, 218) Then
cell.ClearContents
End If
Next
Range("DomesticHotWaterStart").Select
End Sub
under the Module ProtectWorksheet
Sub ProtectON()
Dim ws As Worksheet
Dim pwd As String
pwd = "123" ' Put your password here
For Each ws In Worksheets
ws.Protect Password:=pwd, UserInterfaceOnly:=True
Next ws
'Worksheets("Data Input").Protect Password:="123"
'Worksheets("Contract").Protect Password:="123"
'Worksheets("Invoice").Protect Password:="123"
'Worksheets("Expected Cost").Protect Password:="123"
End Sub
Sub ProtectOFF()
Dim ws As Worksheet
Dim pwd As String
pwd = "123" ' Put your password here
For Each ws In Worksheets
ws.Unprotect Password:=pwd
Next ws
'Worksheets("Data Input").Unprotect Password:="123"
'Worksheets("Contract").Unprotect Password:="123"
'Worksheets("Invoice").Unprotect Password:="123"
'Worksheets("Expected Cost").Unprotect Password:="123"
End Sub
EDIT
I was able to speed it up just a tiny bit by updating my Protect On/Off code below, but it's still a 3-5 second delay when I click on my check boxes:
Sub ProtectON()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Protect Password:="123"
Next
End Sub
Sub ProtectOFF()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Unprotect Password:="123"
Next
End Sub
EDIT - SOLUTION?
So I don't think this is best practice, nor have I really 'solved' my delay, but I found a workaround. I eliminated the delay when clicking my check boxes by turning on protection yet allowing row formatting. Technically my sheet is no longer 100% protected from user tinkering, but I think that risk is worth removing such an annoying wait time after clicking.
Sub ProtectON()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Protect Password:="123", AllowFormattingRows:=True
Next
End Sub
It should not be that slow, although I really have no clue how fast is your PC and how big is the data. However, here is something you can make better:
Sub ClearDomesticHotWater()
For Each cell In [DataInput_DomesticHotWater]
If cell.Interior.Color = RGB(226, 239, 218) Then
cell.ClearContents
End If
Next
End Sub
and remove all selects, they are slowing you down. Go around them like this:
How to avoid using Select in Excel VBA macros
I have this code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Sheets("MACROS").Visible = True
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "MACROS" Then
ws.Visible = xlVeryHidden
End If
Next ws
Application.CommandBars("Ply").Enabled = True
End Sub
The code displays the MACROS sheet when macros are disabled. The thing is that when macros are enabled, and some work had been done on the workbook, and the book is closed by clicking the "X" (Close Button), it prompts to save but displays the MACROS sheet.
I am looking to have the program remain on active sheet while displaying save prompt.
Would someone be so kind to please help me with modifying the above code? All and any help will be greatly appreciated!
Remove the line Sheets("MACROS").Visible = True.
The code should be:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "MACROS" Then
ws.Visible = xlVeryHidden
End If
Next ws
Application.CommandBars("Ply").Enabled = True
End Sub
I have an issue with worksheet protection at the moment. I have read through this forum and found that UserInterfaceOnly = true is useful to avoid having to unprotect the sheet, enter the code and re-protect.
However, I have a requirement to unprotect some sheets by using a macro (there are people with additional access to amend some worksheets that I don't want to know the main password), but the macro doesn't unprotect the sheet.
I am using the following code in the workbook to protect and hide sheets on opening.
Private Sub Workbook_Open()
'unprotect workbook'
Application.ScreenUpdating = False
On Error Resume Next
ActiveWorkbook.Unprotect Password:="PASSWORD"
'Hide all worksheets except Project info and requisition. Protect all worksheets except template - but allowing macros to work while protected'
Dim sheet As Worksheet
For Each sheet In Worksheets
If sheet.Name <> "Project Info" And sheet.Name <> "Requisition" And sheet.Name <> "Template" Then sheet.Visible = xlSheetHidden
If sheet.Name <> "Template" And sheet.Name <> "Task Controls" Then sheet.Protect Password:="PASSWORD", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, UserInterfaceOnly:=True, AllowFiltering:=True
If sheet.Name <> "Template" Then sheet.EnableSelection = xlUnlockedCells
Next
ActiveWorkbook.Protect Password:="PASSWORD", structure:=True, Windows:=False
Application.ScreenUpdating = True
End Sub
This works fine for the vast majority of the workbook (and for which I owe thanks to this forum), however when I use the following code to unprotect a sheet to allow it to be edited, the sheet does not unprotect. Note that this is used from the OK button of a Userform if that makes a difference
Private Sub OK_Button_Click()
Dim Supplier As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Supplier = Me.Supplier_ComboBox.Value
Set ws1 = Sheets("Buyer's Sheet")
Set ws2 = Sheets(Supplier)
On Error Resume Next
ActiveWorkbook.Unprotect Password:="PASSWORD"
ws2.Visible = xlSheetVisible
ActiveWorkbook.Protect Password:="PASSWORD", structure:=True, Windows:=False
ws2.Select
Set ws2 = ActiveSheet
ws2.Columns.Hidden = False
ws2.Unprotect Password:="PASSWORD"
MsgBox "Make the required amendments to the Price List and click the button to return to the home screen", vbOKOnly, "Amend Price List"
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
Unload Me
End Sub
Some of the code is probably fairly inefficient (particularly use of .select) but it appears to work and be pretty stable. The only function that does not work is the worksheet.unprotect function.
Looking more closely at your code after a night's sleep, I believe I see the issue. You're unprotecting the Workbook, then immediately re-protecting it, then trying to unprotect a Worksheet within the protected Workbook. Not 100% certain that's an issue, but try this:
Private Sub OK_Button_Click()
'Dim Supplier As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Sheets("Buyer's Sheet")
Set ws2 = Sheets(Me.Supplier_ComboBox.Value)
On Error Resume Next
ActiveWorkbook.Unprotect Password:="PASSWORD"
ws2.Visible = xlSheetVisible
'remove this line to leave the workbook unptrotected while you're using it
'ActiveWorkbook.Protect Password:="PASSWORD", structure:=True, Windows:=False
'ws2.Select
'Set ws2 = ActiveSheet
'note switched order of next two lines - unprotect FIRST
ws2.Unprotect Password:="PASSWORD"
ws2.Columns.Hidden = False
MsgBox "Make the required amendments to the Price List and click the button to return to the home screen", vbOKOnly, "Amend Price List"
Dim ctl As Control
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
Unload Me
End Sub
Now, based on the text of your MsgBox, it looks like you need to leave the sheet unprotected for the user to make some changes, then (s)he clicks another button that re-protects and does some other processing. I believe that this is the issue - your worksheet is protected, but the workbook protection is overriding it. Again, I'm not 100% certain on this, and the Workbook protection documentation and Worksheet protection documentation aren't very clear (to me) about this.
My changes (cleaned up a couple of unnecessary lines near the top), leaves the workbook and the worksheet unprotected so the user can make changes. I'm assuming that the button click referred to in the MsgBox does, or will be modified to, re-protect everything.
I have this macro for a button to refresh all the pivot-tables in a worksheet:
Sub Button3_Click()
ThisWorkbook.RefreshAll
End Sub
And I wanted to add the functionality to refresh all the pivot tables even if they are on a protected sheet. I protected the pivot-table sheet with the password MyPwd and used the below code, but it won't work:
Sub Button3_Click()
Unprotect Password:="MyPwd"
ThisWorkbook.RefreshAll
Protect Password:="MyPwd", _
DrawingObjects:=True, Contents:=True, _
Scenarios:=True, AllowUsingPivotTables:=True
End With
End Sub
Visual Basic is all new to me. What am I doing wrong?
The Unprotect you want is a worksheet method. You should qualify it.
Sub ProtRef()
Dim TargetSht As Worksheet
Set TargetSht = ThisWorkbook.Sheets("Sheet1") 'Modify as needed.
With TargetSht
.Unprotect MyPwd
ThisWorkbook.RefreshAll
.Protect MyPwd
End With
End Sub
Note TargetSht and the With-End With. Let us know if this helps.
EDIT:
Sub ProtRef()
Dim WB As Workbook, WS As Worksheet
For Each WS In WB.Worksheets
If WS.Name <> "Sheet1" Then
WS.Unprotect MyPwd
End If
End With
ThisWorkbook.RefreshAll
For Each WS In WB.Worksheets
If WS.Name <> "Sheet1" Then
WS.Protect MyPwd
End If
End With
End Sub
Paste in a regular module, like below:
Let us know if this helps.
Thank you #BK201 for having a crack at it, you definitely pointed me in the right direction. I used this code in the button and it seemed to do the trick:
Sub Button1_Click()
Dim Sht As Worksheet
For Each Sht In ThisWorkbook.Worksheets
Sht.Unprotect Password:="MyPwd"
ThisWorkbook.RefreshAll
Next
For Each Sht In ThisWorkbook.Worksheets
Sht.Protect Password:="MyPwd"
Next
End Sub