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.
Related
I have this current code working, however I would like to repeat the same task for quite a few rows in a sheet and other sheets in the workbook.
The task I would like to repeat is to unhide and hide rows based on yes/ no drop down. I understand that it's possible to create a code in module and call it in each sheet. Would appreaciate help.
Thank you!!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C6")) Is Nothing Then Exit Sub
If Target = "Yes" Then
Rows("7:7").Hidden = False
ElseIf Target = "No" Then
Rows("7:7").Hidden = True
End If
End Sub
Perhaps something like this, using the Workbook.SheetChange event. Add this code to the ThisWorkbook code module. It assumes that no other cells besides your drop-downs say "Yes" or "No." It can be easily modified if that is not the case. It can also be modified to only handle certain worksheets and exclude others, if needed.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Select Case Target.Value
Case "Yes"
Target.Offset(1).EntireRow.Hidden = True
Case "No"
Target.Offset(1).EntireRow.Hidden = False
End Select
End Sub
As noted in the answer to your previous question, you can use LCase to make this case-insensitive:
Select Case LCase(Target.Value)
Case "yes"
....
Case "no"
....
End Select
EDIT:
Modified to exclude certain sheets based on their name:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Select Case Sh.Name
Case "Sheet2", "Sheet4" ' change to the names of the sheets to exclude
Exit Sub
End Select
If VarType(Target.Value) = vbString Then
Select Case LCase(Target.Value)
Case "yes"
Target.Offset(1).EntireRow.Hidden = True
Case "no"
Target.Offset(1).EntireRow.Hidden = False
End Select
End If
End Sub
I'm creating a quiz.
Questions on one worksheet and the answers on another.
When a question is answered another field with this formula
=IF(C5="","",IF(C5=Answers!A5,"Correct","Incorrect"))
tells the person if the answer is correct or incorrect.
I am using data validation with dropdown lists so they can only choose true/false, (a, b, c, d) etc.
Is there a way to lock in a selected answer, until a master reset button is pressed?
For example,
Question is in A1
The possible answers are in the form of a dropdown menu in B1.
Sometimes the answer is in the form of a true false, sometime it is in the form of a multiple choice. In the example of true false, if the person puts in true, c3 will say correct or if they put false, then incorrect.
As it is now, the person can switch back and forth as much as they want.
I am looking to make it so once an answer is selected, they cannot change it.
You can use Sheet Protection, combined with Range Locking and a Change event.
Put this code in the relevant Worksheet Module. Adjust the Private constants to suit your needs.
Option Explicit
' Reference the cells that your users may enter data into
Private Const DataCells As String = "J1,J3,J5"
Private Const PW As String = "password"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cl As Range
Dim DataRange As Range
Set DataRange = Me.Range(DataCells)
'Loop thru changed cells
For Each cl In Target.Cells
'If changed cell is in the DataCells range and is not blank, lock it
If Not Application.Intersect(cl, DataRange) Is Nothing Then
If Not IsEmpty(cl) Then
Me.Unprotect PW
Target.Locked = True
Me.Protect PW
End If
End If
Next
End Sub
'Re-enable data entry to all DataCells
Sub MasterReset()
'Unlock the sheet, prompt for password
Me.Unprotect
'Unlock the cells
Me.Range(DataCells).Locked = False
'Optional, clear DataCells
Me.Range(DataCells).ClearContents
'Lock the sheet again
Me.Protect PW
End Sub
This works pretty good:
In the "This Workbook" module, insert the code:
Private Sub Workbook_Open()
Sheet1.Protect userinterfaceonly:=True 'allows macros to run
Sheet1.Range("A1:A20").Locked = False 'replace this range with the range the user deals with.
End Sub
In the sheet module that the user will be interacting with, add this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Locked = True Then Exit Sub
If Target.Locked = False Then
If Target.Value = "" Then Exit Sub
If Target.Value <> "" Then Target.Locked = True
End If
End Sub
That should take care of things for you!
My spreadsheet hides and shows multiple rows by clicking buttons. As the spreadsheet is password protected any macro should apply password, then runs hide/show and finally set password again. This is how its look like.
Sub Macro1()
ActiveSheet.Unprotect Password:="abc"
Rows("12:16").EntireRow.Hidden = True
ActiveSheet.Protect Password:="abc"
End Sub
Sub Macro2()
ActiveSheet.Unprotect Password:="abc"
Rows("12:16").EntireRow.Hidden = False
ActiveSheet.Protect Password:="abc"
End Sub
Sub Macro3()
ActiveSheet.Unprotect Password:="abc"
Rows("20:24").EntireRow.Hidden = True
ActiveSheet.Protect Password:="abc"
End Sub
Sub Macro4()
ActiveSheet.Unprotect Password:="abc"
Rows("20:24").EntireRow.Hidden = False
ActiveSheet.Protect Password:="abc"
End Sub
Script works fine, but I have 16 sections which require 32 macro's. It still works fine but I wonder if there would be an easier way, requiring only 1 line for applying and 1x for setting the password.
Thank you for your comments.
Dennis
The Netherlands
Sub Macro1
HideIt Rows("12:16"), True
End Sub
Sub Macro2()
HideIt Rows("12:16"), False
End Sub
Sub HideRows(rng As Range, HideIt as Boolean)
ActiveSheet.Unprotect Password:="abc"
rng.EntireRow.Hidden = HideIt
ActiveSheet.Protect Password:="abc"
End Sub
If you could name your buttons with something which would enable to to translate the names to a range and true/False, you could link them all to a single Sub and use Application.Caller to get the name of the calling button and extract the parameters from that.
EDIT:
OK here's a very simple example: add two "forms" buttons to your worksheet and name one "btn_12_5_H" and the other "btn_12_5_S".
Here's how you name each button:
Select the button via a right-click
Enter the name in the "name" box in the formula bar and press Enter
Link both buttons to the Sub below (right-click button >> Assign macro):
Sub ShowHideRows()
Dim arr
'split the calling button name into an array
' (array will be zero-based)
arr = Split(Application.Caller, "_")
'**EDIT** check array is expected size...
If UBound(arr) <> 3 Then Exit Sub
If IsNumeric(arr(1)) and IsNumeric(arr(2)) Then
With Me 'if the code is in the sheet module, else "ActiveSheet"
.Unprotect Password:="abc"
'arr(1) determines start row
'arr(2) determines # of rows
'arr(3) determines if rows are hidden or not
.Cells(arr(1), 1).Resize(arr(2), 1).EntireRow.Hidden = (arr(3) = "H")
.Protect Password:="abc"
End With
End If
End Sub
EDIT#2:
Just for completeness, note that you can also add arguments directly to the OnAction (i.e. when you right-click the button an select "Assign macro")
For example you can use something like:
Book1!'ShowHideRows2 12,TRUE'
Note use of single quotes around the whole thing. The called sub might look something like (very basic example to demonstrate that the arguments were properly passed):
Sub ShowHideRows2(rownum, HideIt)
Debug.Print rownum, HideIt
End Sub
Note that because the Sub has parameters it won't show up in the "Assign macro" list and you have to type it in.
After some googling I finally found some code where I could prevent users from placing formulas inside cells. It works great, that's until I protected the sheet. Can anyone tell me what I'm doing wrong? I'm really new to VB.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
Range("I39").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
The entire code for my sub is as follows. I need to stop users from pasting in the cells and putting formulas in them.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C26")) Is Nothing Then
Application.CutCopyMode = True
Application.EnableEvents = False
On Error Resume Next
Range("C26").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
Here is a version that facilitates formula checking over a range of cells:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26:I26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If Target.HasFormula Then
Application.EnableEvents = False
Target.ClearContents
MsgBox "formulas not allowed in cell " & Target.Address
Target.Select
Application.EnableEvents = True
End If
End Sub
If you want to allow data entry in cell C26, but not formula entry, then use the Change Event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If rNoFormulas.HasFormula Then
Application.EnableEvents = False
rNoFormulas.ClearContents
MsgBox "formulas not allowed in cell C26"
rNoFormulas.Select
Application.EnableEvents = True
End If
End Sub
If you just want to protect certain cells only, no vba code is need.
follow this step :
Open sheet that contains cells or columns that you want to protect, press ctrl while selecting those cells or column to be protect, then right click, choose format cells, choose protection tab and uncheck the locked option. those cells or column will not be locked although you have protected the sheet. default setting is all cells in the sheets is locked so you must choose which cells you want to unlock while protecting the sheet. you may record a macro if you still want to use vba. hope this help
Is there a simple way to get Excel to automatically execute a macro whenever a cell is changed?
The cell in question would be in Worksheet("BigBoard").Range("D2")
What I thought would be a simple Google inquiry is proving to be more complicated - every sample involved intersects (whatever those are) or color formatting or any other number of things that appear to be irrelevant.
Yes, this is possible by using worksheet events:
In the Visual Basic Editor open the worksheet you're interested in (i.e. "BigBoard") by double clicking on the name of the worksheet in the tree at the top left. Place the following code in the module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("D2")) Is Nothing Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
On Error Goto Finalize 'to re-enable the events
MsgBox "You changed THE CELL!"
Finalize:
Application.EnableEvents = True
End Sub
Another option is
Private Sub Worksheet_Change(ByVal Target As Range)
IF Target.Address = "$D$2" Then
MsgBox("Cell D2 Has Changed.")
End If
End Sub
I believe this uses fewer resources than Intersect, which will be helpful if your worksheet changes a lot.
In an attempt to find a way to make the target cell for the intersect method a name table array, I stumbled across a simple way to run something when ANY cell or set of cells on a particular sheet changes. This code is placed in the worksheet module as well:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 0 Then
'mycode here
end if
end sub
In an attempt to spot a change somewhere in a particular column (here in "W", i.e. "23"), I modified Peter Alberts' answer to:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Target.Column = 23 Then Exit Sub
Application.EnableEvents = False 'to prevent endless loop
On Error GoTo Finalize 'to re-enable the events
MsgBox "You changed a cell in column W, row " & Target.Row
MsgBox "You changed it to: " & Target.Value
Finalize:
Application.EnableEvents = True
End Sub
I was creating a form in which the user enters an email address used by another macro to email a specific cell group to the address entered. I patched together this simple code from several sites and my limited knowledge of VBA. This simply watches for one cell (In my case K22) to be updated and then kills any hyperlink in that cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("K22")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Range("K22").Select
Selection.Hyperlinks.Delete
End If
End Sub