Question looks big but answer for you guys will be simple
I have code that works for first time and not working for second attempt.
I have 2 sheets "Menu" and "Subsheet"
Basically, i have data validation drop-down set on Menu Sheet yes/no values.
First scenario
Selecting "Yes" will enable the cells on second sheet (Subsheet)
Selecting "No" will disable cells on second sheet(Subsheet).
Second scenario,
User selecting "no" and selecting second sheet will throw a prompt for him to enable cells "ok" and cancel.
Select "ok" will enable cells and value in dropdown will be changed to "yes"
selecting "cancel" in msgprompt will disable cells and value in dropdown will remain "no"
Msg prompt should not be displayed, if user has selected "yes" in dropdown..
Question:Code works fine, until it comes to second scenario.
User selects "No" and selects second sheet in the message prompt, he selects "no". Now cells are disabled.
If user comes back to Menu Sheet and selects "Yes", will not enable cells.
Not sure what is it not enabling cells now. Please help
Code on Menu Sheet
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A11")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case (Target.Value)
Case "YES"
Call uEnable
Case "NO"
Call uDisable
Exit Sub
End Select
Application.EnableEvents = True
End Sub
Code on SubSheet
Private Sub Worksheet_Activate()
UDisable
End Sub
Code on Module
Option Explicit
Private mMessageDisplayed As Boolean
Public Sub uDisable()
If ActiveSheet.ProtectContents And Not mMessageDisplayed Then
mMessageDisplayed = True
If ThisWorkbook.Sheets("Menu").Range("A11") = "NO" Then
If MsgBox("Cells are locked on current sheet, press ok to Unlock", vbOKCancel + vbInformation) = vbOK Then
ThisWorkbook.Worksheets("Menu").Range("A11") = "YES"
With ThisWorkbook.Sheets("Subsheet")
ActiveWorkbook.Unprotect Password:="xyz"
.Range("E13:E14").Locked = False
ActiveWorkbook.Unprotect Password:="xyz"
End With
Else
ThisWorkbook.Worksheets("Menu").Range("A11") = "NO"
With ThisWorkbook.Sheets("Subsheet")
ActiveWorkbook.Unprotect Password:="xyz"
.Range("E13:E14").Locked = True
ActiveWorkbook.Protect Password:="xyz"
End With
End If
Else
Exit Sub
End If
End If
End Sub
Second module
Public Sub uEnable()
With ThisWorkbook.Sheets("Subsheet")
ActiveWorkbook.Unprotect Password:="xyz"
.Range("E13:E14").Locked = False
ActiveWorkbook.Protect Password:="xyz"
End With
End Sub
I tried to use debug method, couldn't identify the root cause.
Two intersect codes
`Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E42")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Dim inputCell As Range
Set inputCell = Range("E43")
Select Case (Target.Value)
Case "Specific Days"
inputCell.Locked = False
inputCell.Activate
Case Else
'This handles **ANY** other value in the dropdown
inputCell.Locked = True
' inputCell.Clear
End Select
Application.EnableEvents = True
If Intersect(Target, Range("E29")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case (Target.Value)
Case "YES"
Call Notify
Case "NO"
Call NotifyUserGeneral
End Select
Application.EnableEvents = True
End Sub`
Remove the Exit Sub from underneath Call uDisable. Otherwise Application.EnableEvents = True never gets called...
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Select Case (Target.Value)
Case "YES"
Call uEnable
Case "NO"
Call uDisable
'Exit Sub <---Can't do this.
End Select
Application.EnableEvents = True
End Sub
...and there isn't any other code that will turn them back on. You can't rely on an event handler to set Application.EnableEvents = True after you've turned off event handling.
Related
Is it possible to make the msgbox of this code to appear only once? My problem is that if the user inserts data i.e. from row 501 until 510 the message box will appear 9 times, and I want to have it only once. The reason of this is because the code looks in each cell to verify if something is inserted, and then the content is deleted and the msg appears. If it is possible I would like to keep the format of the code below, but only to show the msgbox once. If not, any suggestions would be welcomed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell22 As Range
Application.EnableEvents = False
For Each cell22 In Target
If Not Application.Intersect(cell22, Range("a501:z6000")) Is Nothing Then
If cell22.Value <> "" Then
cell22.ClearContents
MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"
End If
End If
Next cell22
Application.EnableEvents = True
End Sub
I would suggest another way.
The tasks which access the worksheet, such as ClearContents takes the longer to process.
So instead of clearing the contents each time inside the loop for a single cell, and repeat it a few hundred times, use ClrRng as a Range object. Every time the If criteria is met, you add it to ClrRng using the Application.Union function.
Once you finish looping through all your cells, clear the entire cells in ClrRng at the same time.
Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell22 As Range, b As Boolean
Dim ClrRng As Range ' define a range to add all cells that will be cleared
Application.EnableEvents = False
For Each cell22 In Target
If Not Application.Intersect(cell22, Range("A501:Z6000")) Is Nothing Then
If cell22.Value <> "" Then
If Not ClrRng Is Nothing Then
Set ClrRng = Application.Union(ClrRng, cell22)
Else
Set ClrRng = cell22
End If
End If
End If
Next cell22
If Not ClrRng Is Nothing Then ' make sure there is at least 1 cell that passed the If criteria
ClrRng.ClearContents ' clear all cell's contents at once
MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"
End If
Application.EnableEvents = True
End Sub
Try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell22 As Range
Application.EnableEvents = False
For Each cell22 In Target
If Not Application.Intersect(cell22, Range("a501:z6000")) Is Nothing Then
If cell22.Value <> "" Then
cell22.ClearContents
GoTo displayMsg
End If
End If
Next cell22
Application.EnableEvents = True
Exit Sub
displayMsg:
MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"
Application.EnableEvents = True
End Sub
This will only show it once but clear each cell which is non-blank.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell22 As Range, b As Boolean
Application.EnableEvents = False
For Each cell22 In Target
If Not Application.Intersect(cell22, Range("a501:z6000")) Is Nothing Then
If cell22.Value <> "" Then
cell22.ClearContents
b = True
End If
End If
Next cell22
If b Then MsgBox "You cannot insert more than 500 rows", vbInformation, "Important:"
Application.EnableEvents = True
End Sub
Looks like something wrong with my code. But, I am not able to figure the problem.
I have 2 tabs on workbook. Main sheet and Sub Sheet.
Selecting "yes" in the drop-down on main sheet will enable Sub sheet for entry.
Selecting "No" in the drop-down on main sheet will disable cells on Sub-sheet.
My problem : When I select "No", I dont see the "Active Cell" on any of the sheets. What I mean by Active Cell is the green border we get when we click on cell(Screenshot attached).
Code on Main Sheet
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("R12")) Is Nothing Then
If Target.Value = "YES" Then
Call Enabler
Else
Call Disabler
End If
End If
Application.EnableEvents = True
End Sub
Code on Modules
Public Sub Disabler()
With ThisWorkbook.Sheets("SubSheet")
.Unprotect Password:="xyz"
.Range("E13:E14").Locked = True
.Protect Password:="xyz"
End With
End Sub
Public Sub Enabler()
With ThisWorkbook.Sheets("SubSheet")
.Unprotect Password:="xyz"
.Range("E13:E14").Locked = False
.Protect Password:="xyz"
End With
End Sub
Something like the following should work for you...
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ExitSub
Application.EnableEvents = False
If Target.Address <> "$R$12" Then Exit Sub
If Target.Value = "YES" Then
Call LockRange(False)
Else
Call LockRange(True)
End If
ExitSub:
Application.EnableEvents = True
End Sub
Private Function LockRange(bFlag As Boolean) As Boolean
On Error Resume Next
With ThisWorkbook.Sheets("SubSheet")
.Unprotect Password:="xyz"
.Range("E13:E14").Locked = bFlag
.Protect Password:="xyz"
'Debug.Print bFlag
End With
LockRange = True
End Function
I guess you have to type in:
.EnableSelection = xlNoRestrictions
BTW you may want to shorten your code by merging Disabler() and Enabler() subs into one Sub:
Public Sub DisableSubSheet(disable As Boolean)
With ThisWorkbook.Worksheets("SubSheet")
.Unprotect Password:="xyz"
.Range("E13:E14").Locked = disable
.Protect Password:="xyz"
.EnableSelection = xlNoRestrictions '<--| make it possible for user to select cells
End With
End Sub
thus, changing your Worksheet_Change event handler code as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("R12")) Is Nothing Then
If Target.Value = "YES" Then
DisableSubSheet False '<--| in place of previous 'Call Enabler'
Else
DisableSubSheet True '<--| in place of previous 'Call Disabler'
End If
End If
Application.EnableEvents = True
End Sub
I have Workbook with both Sheet/workbook is protected.
I have a code to lock/disable certain range of cells when the drop-down value "no" And unlock/enable when value of drop down is "yes"
Whereas, drop-down value and cells I would like to disable are on different sheets.
Dropdown on "Main Sheet"
Range of cells on "Sub Sheet"
I also need to throw a prompt to user when he clicks on protected range and when the value is set to "No".
I am using following code on "Main Sheet"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim worksh As Integer
Dim worksheetexists As Boolean
Dim str1 As String
If UCase$(Range("E30").Value) = "YES" Then
Sheets("SubSheet").Select
Sheets("SubSheet").Range("E20:I3019").Locked = False
Sheets("SubSheet").Range("E20:I3019").Activate
Else
Sheets("SubSheet").Range("E20:I3019").Locked = True
End If
End Sub
Following code on Sub Sheet
Private Sub WorkBook_SheetChange(ByVal sh as Object, ByVal Target as Range)
If Intersect (Target, sh.Range("$E$19:$I$3000")) Is Nothing Then Exit Sub
MsgBox "Please select the appropriate dropdown on MAIN Sheet " & Target.Address
With Application
.EnableEvents = False
.UnDo
.EnableEvents = True
End With
End Sub
Not sure, where am I going wrong as Its not throwing prompt when user clicks on protected cells.
First. You should remove the Sheets("SubSheet").Select. If you running your code and your are not inside the sheet, it could occur an error. try to do:
with ThisWorkbook.Sheets("SubSheet")
If UCase$(Range("E30").Value) = "YES" Then
.Range("E20:I3019").Locked = False
.Range("E20:I3019").Activate
Else
.Range("E20:I3019").Locked = True
End If
end with
Second. You don't return the target range. I mean your Private Sub WorkBook_SheetChange waits for a ByVal Target as a parameter and your Private Sub Worksheet_Change returns any value.It should be a function returning the range or the cell you have selected for me.
EDIT:
with ThisWorkbook.Sheets("SubSheet")
If UCase$(Range("E30").Value) = "YES" Then
.Range("E20:I3019").Locked = False
Else
.Range("E20:I3019").Locked = True
WorkBook_SheetChange Range("E20:I3019")
End If
end with
And
Private Sub WorkBook_SheetChange(ByVal Target as Range)
If Intersect (Target, Range("$E$19:$I$3000")) Is Nothing Then Exit Sub
MsgBox "Please select the appropriate dropdown on MAIN Sheet " & Target.Address
With Application
.EnableEvents = False
.UnDo
.EnableEvents = True
End With
End Sub
I have a macro that disable some row based on the value of others row , witch is working fine
Private Sub Worksheet_Change(ByVal Target As Range)
Call SecurityColumnsLookup(Target)
End Sub
Private Sub Workbook_Open(ByVal Target As Range)
Call SecurityColumnsLookup(Target)
End Sub
Private Sub SecurityColumnsLookup(ByVal Target As Range)
On Error GoTo MyErr
Err.Clear
ActiveSheet.Unprotect
Application.EnableEvents = False
Select Case Range("V" & (Target.Row)).Value
//do stuff
End Select
ActiveSheet.Protect
Application.EnableEvents = True
Exit Sub
MyErr:
On Error Resume Next
ActiveSheet.Protect
Application.EnableEvents = True
Exit Sub
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call SecurityColumnsLookup(Target)
End Sub
What I would like to know is how to add code to my Macro in order to allow user to re-size his rows , because what is happening right now , is when the macro is active and I mouse mouse over the cell the re-size icon doesn't appear
Is it possible to enable re-sizet feature at any time?
Thank you
I found the solution to my problem , as explained in this link
http://www.thespreadsheetguru.com/the-code-vault/2014/2/21/protect-worksheet-but-allow-formatting-and-hiding-rows-columns
Adding this
ActiveSheet.Protect , AllowFormattingColumns:=True, AllowFormattingRows:=True
Application.EnableEvents = True
Will let my Macro enable the resize option !
I am working with the bellow code:
This code do for Example: If I input any value in cell A1, cell B1 display a time stamp.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "hh:mm AM/PM"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
What I am trying to do now is to protect/not editable from the user the cell "B1:B10" once time stamp has made by the macro. I google on how to protect but I am having hard time to insert those code I found. Can anyone help me how I construct/insert this code to my original code?
Private Sub Worksheet_Change(ByVal Target As Range)
'set your criteria here
If Target.Column = 1 Then
'must disable events if you change the sheet as it will
'continually trigger the change event
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "You cannot do that!"
End If
End Sub
Or this code:
'select the cell you want to be editable
Worksheets("Sheet1").Range("B2:C3").Locked = False
'then protect the entire sheet but still vba program can modify instead.
Worksheets("Sheet1").Protect UserInterfaceOnly:=True
Thanks to Kazjaw. Here is the final code.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Protect cell "B1:B10"
Worksheets("Sheet1").Cells.Locked = False
Worksheets("Sheet1").Range("B1:b10").Locked = True
Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=Tru
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "hh:mm AM/PM"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
If you want to protect only Range B1:B10 then you need to run this sub only once:
Sub ProtectCellsInB()
Worksheets("Sheet1").Cells.Locked = False
Worksheets("Sheet1").Range("B1:b10").Locked = True
Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=True
End Sub
I made a modification- I added a password to protection which you can delete.
If you are not sure how to run it once then you could add the whole internal code at the end of your Private Sub Worksheet_Change(ByVal Target As Excel.Range)