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 !
Related
I have the following code which on selection change of a cell searches a separate sheet:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
Dim Finder, ClickRange
Set ClickRange = ThisWorkbook.Sheets("Sheet3").Range("A:A")
If Intersect(Target, ClickRange) Is Nothing Then Exit Sub
Set Finder = ThisWorkbook.Sheets("Sheet4").Range("A:A").Find(Target.Value, LookAt:=xlWhole)
If Finder Is Nothing Then Exit Sub
MsgBox (Finder.Row)
End Sub
However the code isn't working even though in ThisWorkbook I have the following code enabling events
Private Sub Workbook_Open()
Application.EnableEvents = True
End Sub
My sheet names are as follows
Any idea what I might be doing wrong?
Open Immediate Window and type ?Application.EnableEvents
What do you get? A True or False?
If you get True, all is well but if you get False that means Events are disabled somehow (not because of the selection change event code but maybe because of some other code in the workbook).
To enable it again, Type Application.EnableEvents=True in the Immediate Window.
Now place the following code on Sheet3 Module and see if that works fine for you.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim sws As Worksheet
Dim Finder As Range
Set sws = Sheets("Sheet4")
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target <> "" Then
Set Finder = sws.Range("A:A").Find(Target.Value, lookat:=xlWhole)
If Not Finder Is Nothing Then
MsgBox Finder.Row
Else
MsgBox Target.Value & " was not found on " & sws.Name & ".", vbExclamation, "Not Found!"
End If
End If
End If
End Sub
Try enabling and disabling events like below. This will not only ensure that Events are enabled but will avoid potential issue of calling the event in a loop.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Goto errExit
Application.EnableEvents = False
If Target.CountLarge > 1 Then Exit Sub
If Target.Value = vbNullString Then Exit Sub
Dim Finder As Range ', ClickRange
'Set ClickRange = ThisWorkbook.Sheets("Sheet3").Range("A:A")
'/* If this code is in Sheet3, you can use below */
If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub
Set Finder = _
ThisWorkbook.Sheets("Sheet4").Range("A:A").Find(Target.Value, _
LookAt:=xlWhole)
If Finder Is Nothing Then Exit Sub
MsgBox (Finder.Row)
errExit:
Application.EnableEvents = True
End Sub
Try this first and let us know what you get. Hope this helps.
VBA newbie here.
I have an excel spreadsheet that is locked for formatting. However, if you paste into the spreadsheet, the format copied is then pasted into the locked worksheet. I'm using the code below to create an event in excel to undo and paste special values.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Application.CutCopyMode = xlCopy Then
Application.EnableEvents = False
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End If
End Sub
This works perfectly, however, this only works if I am copying and pasting within the same excel session. How can I get this to work across all excel instances?
Thanks!
Dan
Paste this into the Thisworkbook module of the same file (assuming that moduleis currently empty!):
Option Explicit
Private WithEvents App As Application
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode = xlCopy Then
Application.EnableEvents = False
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set App = Nothing
End Sub
Private Sub Workbook_Open()
Set App = Application
End Sub
This question already has answers here:
Why MS Excel crashes and closes during Worksheet_Change Sub procedure?
(3 answers)
Closed 4 years ago.
I have reworked this macro for two days in a load of different ways to try to prevent steps from repeating but the range G2 step seems to run 3 or 4 times and the range G3 2 or 3 times. Does anyone have any ideas??
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Exit Sub
End If
End Sub
Your Worksheet_Change has succumbed to three of the most common mistakes in an event driven worksheet/workbook sub procedure.
You are not disabling events while making modifications to the worksheet. Each change triggers another event and the Worksheet_Change tries to run on top of itself over and over until it crashes.
Target could be a single cell or many cells. You need to deal with the possibility of Target being many cells by using Intersect to only get the affected cells within your range of possibilities.
If you disable events for any reason, make sure to provide error control that turns them back on if everything goes south. Typically, this can be done just before exiting the Worksheet_Change but not if you are going to use Exit Sub.
Here is my version of your procedure.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4, G2:G4")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("D4, G2:G4"))
Select Case trgt.Address(0, 0)
Case "G2"
Range("G3:G4") = Application.Transpose(Array("Division", "Team"))
'call check is below
Case "G3"
Range("G4") = "Team"
'call check is below
Case "D4", "G4"
'call check is below
End Select
Next trgt
Call check
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Your code is in the Worksheet_Change event. Every time the worksheet is changed this event fires, including when your code changes it
Range("g4").Value = "Team"
Thus you're stuck in a potentially infinite loop. To avoid this disable events before making any changes
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' this turns events off
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End Sub
You might need to enable or disable events within the subs you're calling too.
BTW I'd check if you really need those Exit Subs, if not you can just disable events once at the start and re-enable again at the end.
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
My problem is that the macros I wrote change the values of the cells triggering again a macro to change one of the other cells.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
For Each cell In Target
If Not Intersect(cell, Range("c2")) Is Nothing Then
Macro1
ElseIf Not Intersect(cell, Range("C3")) Is Nothing Then
Macro2
ElseIf Not Intersect(cell, Range("d8")) Is Nothing Then
Macro3
End If
Next cell
End Sub
The macros running always change the other cells, what makes it a endless loop at the moment.
Is there a way to only make manual input/ change of the cell let the macro run?
Two solutions for this :
Add Application.EnableEvents = False at the start of your _change event and set it to True at the end
Create a Public Boolean to test if you are already doing any update automatically
Something like this (solution 2) :
Public DisableEvents As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If DisableEvents Then Exit Sub
DisableEvents = True
Dim cell As Range
For Each cell In Target
If Not Intersect(cell, Range("c2")) Is Nothing Then
Macro1
ElseIf Not Intersect(cell, Range("C3")) Is Nothing Then
Macro2
ElseIf Not Intersect(cell, Range("d8")) Is Nothing Then
Macro3
End If
Next cell
DisableEvents = False
End Sub
Sub Macro1()
If DisableEvents Then Exit Sub
'Rest of your code
End Sub