Have the following code at the Workbook object level, but it's not allowing for the autofilter or ungrouping of columns.
Private Sub Workbook_Open()
For Each ws In Sheets
With ws
.Protect Password:="xxxxxxxx", Userinterfaceonly:=True,
AllowFormattingColumns:=True, AllowFormattingRows:=True, _
AllowFiltering:=True, AllowInsertingRows:=True,
AllowSorting:=True, AllowDeletingRows:=True
End With
Next ws
End Sub
Related
I'm writing a VBA macro that protects another workbook when user clicks a button and open it via current workbook. I got "Application-defined or Object-defined error". I looked into this post and made sure that the workbook that needs to be opened is unprotected. But the error still occurs. Please help. Thanks!
Sub LockModelParInput()
Dim wbk As Workbook
Workbooks.Open (ModelParVarClusLocalPath & "\" & ProN & "_ModelParameter_UserInput.xlsx")
Set wbk = Workbooks(ProN & "_ModelParameter_UserInput.xlsx")
wbk.Activate
With ActiveWorkbook.Worksheets("Model_Rule")
.Protection.AllowEditRanges.Add Title:="VIF Cut Off Level 2", _
Range:=Range("C4") *'error occurs on this line*
.Protection.AllowEditRanges.Add Title:="p_value stay", Range:= _
Range("D4")
.Protection.AllowEditRanges.Add Title:="Trend Threshold", Range _
:=Range("E4")
.Protection.AllowEditRanges.Add Title:="r_var_ks_penalize", Range _
:=Range("B10")
.Protection.AllowEditRanges.Add Title:="fast backward", Range:= _
Range("C16")
.Protection.AllowEditRanges.Add Title:="locked forward", Range:= _
Range("C17")
.Protection.AllowEditRanges.Add Title:="enhanced stepwise", Range _
:=Range("C18")
.Protection.AllowEditRanges.Add Title:="traditional backward", _
Range:=Range("C19")
.Protection.AllowEditRanges.Add Title:="sas stepwise", Range:= _
Range("C21")
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub
You need to check to see if the edit range's title has already been used - they can't be duplicated. Just knock up a quick function like this to iterate them:
Private Function EditRangeExists(Sh As Worksheet, Title As String) As Boolean
With Sh.Protection
Dim found As AllowEditRange
For Each found In .AllowEditRanges
If found.Title = Title Then
EditRangeExists = True
Exit Function
End If
Next
End With
End Function
...then check to make sure you're not attempting to add duplicates. I'd use a small wrapper for the test to make your code cleaner:
Private Sub TryAddProtectionRange(Title As String, Target As Range)
With Target
If EditRangeExists(Target.Parent, Title) Then
Exit Sub
End If
.Parent.Protection.AllowEditRanges.Add Title, Target
End With
End Sub
Then you can use it like this:
Sub LockModelParInput()
Dim wbk As Workbook
Set wbk = Workbooks.Open(ModelParVarClusLocalPath & "\" & ProN & _
"_ModelParameter_UserInput.xlsx")
Dim Sh As Worksheet
Set Sh = wbk.Worksheets("Model_Rule")
With Sh
TryAddProtectionRange "VIF Cut Off Level 2", .Range("C4")
TryAddProtectionRange "p_value stay", .Range("D4")
'Etc.
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub
I'd add some sort of error handling and/or have TryAddProtectionRange return a Boolean for success also.
I have this code to refresh my connections from excel to MySQL, I made it in such a way when someone tries to refresh in a PC that is not in the network it would throw a msg saying sever connection lost..
It only does the refresh part but when I use the excel file in a PC not connected to the network it doesn't show my custom message.
Sub refreshall()
Dim answer As Integer
Dim wSheet As Worksheet
On Error GoTo Handler
answer = MsgBox("Refresh All Sheets At Once?", vbYesNo + vbQuestion, "Refresh All")
If answer = vbYes Then
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For Each wSheet In Worksheets
wSheet.Unprotect Password:="Secret"
Next wSheet
ActiveWorkbook.refreshall
For Each wSheet In Worksheets
wSheet.Protect Password:="123", UserInterfaceOnly:=True, _
AllowFiltering:=True, _
AllowSorting:=True, _
AllowUsingPivotTables:=True
Next wSheet
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Exit Sub
Else
Exit Sub
End If
Exit Sub
Handler:
For Each wSheet In Worksheets
wSheet.Protect Password:="123", UserInterfaceOnly:=True, _
AllowFiltering:=True, _
AllowSorting:=True, _
AllowUsingPivotTables:=True
Next wSheet
MsgBox "Server Connection Lost...", vbOKOnly + vbCritical, "Warning"
Exit Sub
End Sub
As I understand, exactly ActiveWorkbook.refreshall throws handler section when your PC is connected to the network.
I guess Excel itself detects that there is no network and don't execute some part of its own algorithms inside of RefreshAll sub so ActiveWorkbook.refreshall execution in this case causes no exeptions.
I cannot lock my sheet because I need to access some cells to run macros.
I want a macro that selects cell (F1) whenever the user try to select any other cell.
I need a macro like this one, I guess:
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Put this code in the worksheet module:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Cells(1, 6).Select
End Sub
Like other guys wrote, is better to unprotect the sheet, play your macro and protect the sheet but, if you think that disable all cells, minus the cell that you identify, is the best way, you can use this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("F10")) Is Nothing Then 'use your free cell
do
Else
Application.Undo
MsgBox "you can modify only the cell(F10)" 'Just to inform what is the cell editable
Range("F10").Select
End If
Application.EnableEvents = True
End Sub
Here are 2 options:
.
1. Without protecting the sheet - in each sheet module to customize "unlocked" cell (Ex. "C3")
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Column <> 3 Or .Row <> 3 Or .CountLarge > 1 Then Application.Undo
End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Column <> 3 Or .Row <> 3 Or .CountLarge > 1 Then Cells(3, 3).Select
End With
Application.EnableEvents = True
End Sub
.
2. Protecting the sheet - in ThisWorkbook module
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
protectWS ws
Next
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
protectWS Sh
End Sub
Public Function protectWS(Optional ByRef ws As Worksheet = Nothing) As Boolean
If ws Is Nothing Then Set ws = Application.ActiveSheet
If Not isWSProtected(ws) Then
ws.Protect Password:=vbNullString, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=False, _
AllowFiltering:=False, _
AllowUsingPivotTables:=False
End If
End Function
Private Function isWSProtected(Optional ByRef ws As Worksheet = Nothing) As Boolean
isWSProtected = ws.ProtectContents Or _
ws.ProtectDrawingObjects Or _
ws.ProtectScenarios
End Function
Option 1 forces users to cell C3
can be moved to ThisWorkbook module, with parameters for row and column
Option 2 is using an empty password, and allows VBA execution (UserInterfaceOnly)
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
I have a macro that opens automatically and applies a special sheet protection which allows for grouping and some editing for a specific sheet, Program Data. The macro I have is this:
Private Sub Workbook_Open()
With Worksheets("Program Data")
.EnableOutlining = True
.Protect UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True,
AllowInsertingRows:=True
End With
End Sub
Right now this runs as soon as you open the file, but it only applies to Program Data. I don't know how to change the with statement to accommodate the entire workbook without naming the sheets one-by-one. But there are very many sheets, so that's not a good option. How do I do apply this for all sheets in the file?
You can loop through the worksheet objects like this.
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
With ws
.EnableOutlining = True
.Protect UserInterfaceOnly:=True, AllowFiltering:=True, _
AllowFormattingColumns:=True, AllowInsertingRows:=True
End With
Next
End Sub
You want a For loop that targets all the sheets. Basically...
Private Sub Workbook_Open()
Dim WS As Worksheet
For Each WS in ThisWorkbook.Worksheets
With WS
.EnableOutlining = True
.Protect UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True,
AllowInsertingRows:=True
End With
Next WS
End Sub
Let us know if this helps.
try this
For i = 1 To Worksheets.Count - 1
With Worksheets(i)
.EnableOutlining = True
.Protect UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True, AllowInsertingRows:=True
End With
Next