I have problem with ClearContents in Worksheet_Change as it keep ClearContents of the range and doesn't allow me for data entry. i want ClearContents to done only one time
would you help me with that
the code I use below
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Range("A6") = "Semi Auto" Then
Range("E5:L5").ClearContents
Range("E6:L6").Formula = Range("E14:L14").Formula
End If
Application.EnableEvents = True
End Sub
This one will only trigger, if the change is concerning Range("A6"):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A6")) Is Nothing Then Exit Sub
If Range("A6") = "Semi Auto" Then
Range("E5:L5").ClearContents
End If
End Sub
A Worksheet Change
When you copy the code into the sheet module, the second solution will be 'active'. It is the Play solution, which you should use to explore how the Worksheet Change event behaves.
When done testing, delete it or rename it, and then rename the first, the Real solution, to Worksheet_Change without the 1.
This will only work if you're manually changing the values in A6, which also includes the change via dropdown or VBA code. If you have a formula in A6 this will not work.
The Code
Option Explicit
Private Sub Worksheet_Change1(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Not IsError(Range("A6")) Then
If Range("A6") = "Semi Auto" Then
Application.EnableEvents = False
On Error GoTo SafeExit
Range("E5:L5").ClearContents
Range("E6:L6").Formula = Range("E14:L14").Formula
On Error GoTo 0
Application.EnableEvents = True
End If
End If
End If
ProcExit:
Exit Sub
SafeExit:
Application.EnableEvents = True
GoTo ProcExit
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Not IsError(Range("A6")) Then
If Range("A6") = "Semi Auto" Then
MsgBox "Semi Auto."
Else
MsgBox "Not Semi Auto."
End If
Else
MsgBox "Is error value."
End If
Else
MsgBox "Not cell ""A6""."
End If
End Sub
Related
I have simple macros for clearing cells on "Sheet1", which have drop down lists.
Sub reset1()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
Range("D6:E7").ClearContents
End Sub
Sub reset2()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
End Sub
Then I call these macros on "Sheet1" if the cell values change
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$4" Then
Call reset1
End If
If Target.Address = "$D$6" Then
Call reset2
End If
End Sub
This code is written on the "Sheet1".
Normally it works but sometimes reset1() doesn't work.
I should then save and reopen the excel or run the macro manually.
Should I better modify some codes?
First problem is that with Range("D20:E21") it is not clear in which worksheet that range should be. Always specify the worksheet like Worksheets("Sheet1").Range("D20:E21").
Second problem is that if you .ClearContents in a Worksheet_Change event this is a cell change and triggers another Worksheet_Change event and so on. So it is recommended to disable events Application.EnableEvents = False before changing cells in Worksheet_Change event.
Third problem is that if you test Target.Address = "$D$4" and you copy paste a range where D4 is included your code will not run even if your cell D4 changed. Therefore you always need to work with Intersect.
Option Explicit
Sub Reset1(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9,D6:E7").ClearContents
' alternative:
' Union(ws.Range("D20:E21"), ws.Range("D8:E9"), ws.Range("D6:E7")).ClearContents
End Sub
Sub Reset2(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9").ClearContents
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Goto ENABLE_EVENTS ' in any case an error happens make sure events are enabeld again
If Not Intersect(Target, Me.Range("D4")) Is Nothing Then
Reset1 Me ' here we tell Reset1 to take `Me` as worksheet. Me refers to the worksheet `Target` is in.
End If
If Not Intersect(Target, Me.Range("D6")) Is Nothing Then
Reset2 Me
End If
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number Then
Err.Raise Err.Number
End If
End Sub
I have been using this code which copies the range and paste the range as picture but when i change the concerns cell it throws an error that is Error 1004, Microsoft Excel cannot paste the data.
Any help will be appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C5:P5")) Is Nothing Then
Application.CutCopyMode = TRUE
ActiveSheet.Pictures.Delete
Worksheets("Pivot").Range("FC3:FP35").Copy
With Worksheets("Map")
.Activate
.Range("C8").Select
.Pictures.Paste
End With
Application.CutCopyMode = FALSE
End If
End Sub
You need to turn off events Application.EnableEvents = False before changing cells and turn them on after. Make sure they get turned on in any case of an error in this event or you will not be able to fire any other events in your Excel instance. So error handling in this event is a must have. • You might benefit from reading
How to avoid using Select in Excel VBA.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("C5:P5")) Is Nothing Then
On Error Goto ERR_ENABLE_EVENTS
Application.EnableEvents = False
Me.Pictures.Delete
Worksheets("Pivot").Range("FC3:FP35").Copy Destination:=Worksheets("Map").Range("C8").Paste
End If
ERR_ENABLE_EVENTS:
Application.CutCopyMode = False
Application.EnableEvents = True
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Sub
I need help for generating the macro that basically gives the value "200000" based on a drop down menu in a cell. This drop down menu has two defined values in it(120 and 480). If other value in the drop down menu is selected then, I should have the freedom of writing any value that I want. The code which I came up with is below
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("$G$11")) Is Nothing Then
Range("$B$20:$R$25,$Z$20:$AM$25").ClearContents
End If
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("$G$11")) Is Nothing Then
Range("$F$16:$Q$16,$R$15:$U$16,$V$16:$AA$16,$AB$15:$AM$16").ClearContents
End If
If Range("I16") = 120 Or Range("I16") = 480 Then
Range("F16") = 200000
Else
Range("F16") = ""
End If
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
However, I have another macro which clears all the contents in the cells due to which the above code is causing an error. Any help is much appreciated.
Make sure you're not re-triggering your event handler from within.
Also worth adding an error handler to make sure events aren't left turned off.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim v
On Error GoTo exitHandler
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("G11")) Is Nothing Then
Application.EnableEvents = False
Me.Range("B20:R25,Z20:AM25,F16:Q16,R15:U16,V16:AA16,AB15:AM16").ClearContents
End If
If Not Intersect(Target, Me.Range("I16")) Is Nothing Then
v = Target.Value
Application.EnableEvents = False
Me.Range("F16").Value = IIf(v = 120 Or v = 480, 200000, "")
End If
exitHandler:
Application.EnableEvents = True
End Sub
Basically you just need to disable events before clearing cells so that the Change code is not triggered.
I'm not sure how the second bit of code relates so may need some adjustment.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("$G$11")) Is Nothing Then
Application.EnableEvents = False
Range("$B$20:$R$25,$Z$20:$AM$25").ClearContents
Range("$F$16:$Q$16,$R$15:$U$16,$V$16:$AA$16,$AB$15:$AM$16").ClearContents
If Range("I16") = 120 Or Range("I16") = 480 Then 'presumably belongs elswhere as just cleared I16 above?
Range("F16") = 200000
Else
Range("F16").Clear
End If
End If
Application.EnableEvents = True
exitHandler:
Application.EnableEvents = True
Exit Sub
End Sub
I'm receiving a type 13 mismatch error with Excel VBA. This script checks two columns and locks cells in a column once a change is made, or doesn't lock it if the user clicks the cell and clicks off without any changes. Line 5 is apparently the culprit. Any help is much appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Union(Range("I:I"), Range("J:J"))
If Intersect(Target, A) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
ActiveSheet.Unprotect Password:="YourPassword"
Target.Locked = True
ActiveSheet.Protect Password:="YourPassword"
End Sub
Target is the cell or cells that have been changed. If Target is more than a single cell (e.g. pasted block of values, etc) then Target does not have a .Value. Add If Target.Count > 1 Then Exit Sub to the top of the code or loop through Target, examining each cell within Target for the .Value.
Example of the latter,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Union(Range("I:I"), Range("J:J"))) Is Nothing Then
On Error GoTo bm_Safe_Exit
ActiveSheet.Unprotect Password:="YourPassword"
Application.EnableEvents = True
Dim ij As Range
For Each ij In Intersect(Target, Union(Range("I:I"), Range("J:J")))
If ij.Value <> "" Then
ij.Locked = True
End If
Next ij
End If
bm_Safe_Exit:
ActiveSheet.Protect Password:="YourPassword"
Application.EnableEvents = True
End Sub
Additionally, it is not considered a 'best practise' to use the ActiveSheet property in a Worksheet_Change event macro.
I have a macro that is supposed to hide a row in excel when a value of a given cell is "ODD" (the word, not an odd number). I've tried two different formats; neither gives any visible error but neither hides the row.
Sub Worksheet_Change(ByVal target As Range)
If target.Address <> "$B$2" Then Exit Sub
ElseIf Range("B2").Value = "ODD" Then
Rows("5:5").EntireRow.Hidden = False
Else
Rows("5:5").EntireRow.Hidden = True
End If
End If
End Sub
The other code I had is:
Select Case Range("B2").Value
Case Is = "ODD": Rows("5:5").EntireRow.Hidden = False
Case Else: Rows("5:5").EntireRow.Hidden = True
End Select
It was modified from a more advanced case statement and I just left it that way at first.
The Rows("5:5") would be better as Rows(5). The method you used would be better as Range("5:5").
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Rows(5).EntireRow.Hidden = (UCase(Target.Value) = "ODD")
End If
End Sub
Since comparing B2 to ODD already produces a True or False, you can dispense with the If/Else/End If. Text comparisons in VBA are usually case sensitive, hence the need for UCase to force case insensitivity.
You are missing a key code line If Not Application.Intersect(cell, Range(Target.Address)) Is Nothing Then Try the following
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Set cell = Range("B2")
If Not Application.Intersect(cell, Range(Target.Address)) Is Nothing Then
If Range("B2").Value = "ODD" Then
Rows("5:5").EntireRow.Hidden = False
Else
Rows("5:5").EntireRow.Hidden = True
End If
End If
End Sub
First make sure your Change Sub is stored in the Worksheet module of the Sheet you want this to perform on. Then you have a slight syntax error with your If Statements:
Private Sub Worksheet_Change(ByVal target As Range)
If target is Nothing Then Exit Sub
If target.Address <> "$B$2" Then Exit Sub
If Range("B2").Value = "ODD" Then
Rows("5:5").EntireRow.Hidden = True
Else
Rows("5:5").EntireRow.Hidden = False
End If
End Sub
When you put the If...Then... on one line, it actually closes the If (no End If needed) Also, I flipped your True and False statements to match your requirement in your question.