Pass the Protection Status of Excel Worksheet to a Cell - excel

I'm curious as to whether it's possible to pass the protection status of an excel worksheet to a cell of that worksheet.
e.g.
Sheet1 is locked for editing...cell A1 would be programmed to say "locked"
Sheet1 is unlocked...cell A1 would say "unlocked".
A button on the sheet would be used to toggle worksheet protection on and off.
My sheet will be locked upon opening using a workbook_open event.
This is for a sheet where I don't want the formulae getting all mucked up upon use, but where full access might be required. Its more as a reminder to the user that they are in "Unlocked" Mode so to be extra careful.
Is using VBA a foregone conclusion?
I'm a VBA noob but don't mind using code as a solution for this
Any thoughts or suggestions welcome

You could use code in an ActiveX button on Sheet1 to do this simply
Const strPAss = "test"
Private Sub CommandButton1_Click()
If ActiveSheet.ProtectContents Then
ActiveSheet.Unprotect strPAss
[a1].Value = "unlocked"
Else
[a1].Value = "locked"
ActiveSheet.Protect strPAss
End If
End Sub

Put this in the worksheet's code module, which will place a reminder in the Status Bar (this avoids needing to lock/unlock the sheet in order to write the status in to cell A1).
Put this in Sheet1 code module. The macro will execute every time sheet1 is activated.
Private Sub Worksheet_Activate()
If ActiveSheet.ProtectContents then
Application.StatusBar = "This sheet is protected"
Else:
Application.StatusBar = "This sheet is unprotected"
End If
End Sub
Private Sub Worksheet_Deactivate()
Application.StatusBar = False
End Sub
To protect/unprotect the worksheet you could add this to an Insert>Module. Then attach these macros to separate command buttons, or run from the Developer>Macros ribbon.
Const myPassword as String = "password" '<-- replace "password" with your password
Sub Sht1Protect()
Sheet1.Protect myPassword
End Sub
Sub Sht1Unprotect()
Sheet1.Unprotect myPassword
End Sub
To ensure the sheet is always protected when you close the file, insert this in the Workbook code module
Private Sub Workbook_Close()
Sht1Protect
End Sub
You may need additional handling to control whether the file is saved/not saved etc.

Related

Stopping all execution in VBA

I have a workbook with multiple sheets with an Activate sub and one sheet without, let's call it Sheet0. I want to, when switching from Sheet0 to any other sheet, check that some condition is met on Sheet0 before switching and stay on Sheet0 if the condition isn't met. I added a Deactivate sub in Sheet0 so that, when switching sheets, the condition is checked and if is not met, pops a message box and ends execution before the Activate sub from the other sheet runs.
Private Sub Worksheet_Deactivate()
If blnCondition Then
MsgBox ("[...]")
Me.Activate
End
End If
End Sub
I used the End statement but for some reason, it doesn't work as I thought it would. It ends execution of the Deactivate sub but still jumps to the other sheet's Activate sub, same as if I used an Exit Sub. My understanding of the End statement was that it was the ultimate stopping method in VBA.
Is my comprehension of the End statement wrong or am I missing something else?
Workbook SheetDeactivate Event
Workbook.SheetDeactivate Event
Copy the following code into the ThisWorkbook module. Sheet1 is the name of the worksheet that you don't want to deactivate if a condition is not met, in this example, if cell A1 is empty.
Option Explicit
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If Sh.Name = "Sheet1" Then
If IsEmpty(Sh.Range("A1")) Then
Sh.Activate
Sh.Range("A1").Select
MsgBox "Cell 'A1' is empty.", vbCritical
End If
End If
End Sub
EDIT
To prevent triggering the Worksheet Activate events of the remaining worksheets you will need to use a global (public) variable that will indicate if it is safe to activate them i.e. the condition in e.g. Sheet1 is met. At the beginning of each of the Worksheet Activate event codes of the remaining worksheets, you will need to add an If statement checking for the value of the global variable.
Relevant Sheet Module, e.g. Sheet1 (code name, the name not in parentheses)
Option Explicit
Public IsNotMet As Boolean
Private Sub Worksheet_Deactivate()
If IsEmpty(Range("A1")) Then
IsNotMet = True
Me.Activate
Range("A1").Select
MsgBox "Cell 'A1' is empty.", vbCritical
Else
IsNotMet = False
End If
End Sub
All Other Sheet Modules
Option Explicit
Private Sub Worksheet_Activate()
If Sheet1.IsNotMet Then Exit Sub
' Your code, e.g.:
MsgBox "Worksheet '" & Me.Name & "' activated.", vbinformation
End Sub

VBA disabling drag and drop prevents users to copy and paste to another workbook

I've tried to disable drag and drop on a specific Excel workbook.
I wrote the following code on VBA editor on 'My Workbook' section.
Private Sub Workbook_Activate()
Application.CellDragAndDrop = False
End Sub
Private Sub Workbook_Deactivate()
Application.CellDragAndDrop = True
End Sub
Problem is: after that people cannot copy-paste any cell from this workbook to another.
How's so?
Thank you for any suggestion

Enable Drop Down Macro for Protected Sheet

I have created a macro that allows a user to select an option from a dropdown list which unhides selected rows that corresponds with their selection. The problem is when I protect the sheet I get the following error "Run-time error '1004'" when I select an option for the drop down list. I need this sheet to be protected so the user cannot touch the data sets shown. Here is a sample code (original version is very long):
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Activate
If Not Application.Intersect(Range("C15"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is ="Option 1"
Rows("17:75").EntireRow.Hidden = True
Case Is ="Option 2"
Rows("17:28").EntireRow.Hidden = False
End Select
End If
End Sub
I've been reading other threads and I've come across a few options that said I need to Unprotect and Protect my sheet but I'm not to sure how to add this to the code above. And if this is the best option for what I am trying to accomplish
Option 1
Sub UnprotectAll()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect Password:=yourPassword
Next sh
End Sub
Sub ProtectAll()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Protect Password:=yourPassword
Next sh
End Sub
Option 2 - Adding this code somewhere below
UserInterFaceOnly:=True
Any suggestions in how I can accomplish this? And what the full code would look like?
Thanks so much!
#ExcelNoob I’ve made the following assumptions based on your question:
Only the active sheet is relevant
You formatted cell C15 as not Locked (when the sheet is unprotected, right click C15 /format/protection and uncheck ‘locked’ & ‘hidden’
You have indicated the correct rows you want hidden or not (seem a bit odd?)
There are only 2 options
That being the case, the minimum code below will do what you ask. If you want to use a specific password, just put it between the double quotation marks.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C15"), Target) Is Nothing Then
ActiveSheet.Unprotect Password:=""
If Range("C15").Value = "Option 1" Then
Rows("17:75").Hidden = True
ElseIf Range("C15").Value = "Option 2" Then
Rows("17:28").Hidden = False
End If
ActiveSheet.Protect Password:=""
End If
End Sub
As per above, but if you don't want to protect/unprotect, put your drop down in a form and use :
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Sheet1.Protect "Password", UserInterfaceOnly:=True
End Sub
Where "password" is changed to whatever password you want.

Using VBA userform to select ranges on multiple sheets - sheet changes back to original activesheet

I have a userform which has multiple RefEdit controls. I need the user to select ranges from multiple sheets and the userform has to be complete before the rest of the code can run.
Issue: The activesheet is "Sheet1" when the userform is initiated. Each time I select a range on "Sheet2" and click into the next RefEdit the visible Excel sheet returns to "Sheet1". I'd like the sheet to remain on "Sheet2", since clicking between the sheets significantly increases the time it takes to select the data.
Because I need the userform to be completed before continuing with my code, using "vbModeless" doesn't appear to work.
I've tried to step through the userform events which appeared to be relevant but none were activated when I entered the RefEdit, selected the data, or left the RefEdit.
Thanks in advance for any help!
Edit: Using some input from the responses and doing some more research I think I've figured out the problem and a work around.
RefEdit events such as Change or Exit (I tried all of them I think) don't appear to trigger when a change occurs in the control. So I couldn't write code to manipulate the activesheet when I changed the control. A workaround found here: http://peltiertech.com/refedit-control-alternative/ uses a textbox and inputbox to simulate a RefEdit control and will actually trigger when changes are made! Code is below. To add other "RefEdit" controls you should repeat the code in the Userform_Initialize event for each control, then add another TextBox1_DropButtonClick and update TextBox1 to the name of the new control. In use when the control updates the workbook jumps to the previous activesheet and then returns the desired activesheet. Not as smooth as I'd like but much better than it was.
Code:
Private Sub CancelButton_Click()
Unload Me
End
End Sub
Private Sub OKButton_Click()
UserForm1.Hide
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
End
End Sub
Private Sub UserForm_Initialize()
Me.TextBox1.DropButtonStyle = fmDropButtonStyleReduce
Me.TextBox1.ShowDropButtonWhen = fmShowDropButtonWhenAlways
End Sub
Private Sub TextBox1_DropButtonClick()
Dim ASheet As String ' Active sheet
Me.Hide
'Use input box to allow user to select a range
On Error Resume Next
Me.TextBox1.Value = Application.InputBox("Select the range containing your data", _
"Select Chart Data", Me.TextBox1.Text, Me.Left + 2, _
Me.Top - 86, , , 0)
On Error GoTo 0
'Check if there is a sheet name - if the range selected is on the activesheet the output of the inputbox doesn't have a sheet name.
If InStr(1, Me.TextBox1.Value, "!", vbTextCompare) > 0 Then ' there is a sheet name
ASheet = Replace(Split(Me.TextBox1.Value, "!")(0), "=", "") ' extract sheet name
Else ' there is no sheet name
Me.TextBox1.Value = "=" & ActiveSheet.Name & "!" & Replace(Me.TextBox1.Value, "=", "") ' add active sheet name to inputbox output
ASheet = ActiveSheet.Name
End If
Worksheets(ASheet).Activate ' set the active sheet
Me.Show
End Sub
Have you tried something as simple as:
Sheets("Sheet2").Select
somewhere in the beginning of your form code ?
Since you haven't posted your code, it's hard to provide a good answer.
Hope this helps a little :)
This form module worked for me.
Private Sub CommandButton1_Click() 'Cancel Button
Unload Me
End Sub
Private Sub CommandButton2_Click() 'GO Button
Dim newSheet As Worksheet
abc = Split(RefEdit1.Value, "!")
cbn = abc(0)
Unload Me
Set newSheet = Worksheets(abc(0))
newSheet.Activate
End Sub

VBA code to lock only user selected (Highlighted) cells in excel

I was wondering how can i one use VBA/macros to lock certain excel cells that are selected/highlighted by the user.
The code im using right now is locking the entire sheet.
Sub Macro4()
'
' Macro4 Macro
'
'
Worksheets("Sheet1").Activate
ActiveSheet.Unprotect
Cells.Select
Selection.Locked = True
ActiveSheet.Protect
End Sub
Any ideas on what im doing wrong?
Thank you for your time.
If you want to perform any actions on the selected cell(s) every time a new selection occurs, you should rely on the code being triggered when this happens:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Selection.Locked = True
End Sub
This inside the file with the code for the given sheet; that is, if you want to consider Sheet1, the file where you have to write this code is: Microsoft Excel Objects/Sheet1 (Sheet1).
UPDATE AFTER YOUR COMMENT
Sub Button1_Click()
Selection.Locked = True
End Sub
This code locks all the cells selected when the Button1 is clicked.

Resources