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
Related
I have a multiple selection, Option buttons, that change the value of cell D7 from 1 to 5, depending on choice. I want to unhide rows 16 to 26 if value is 1 and hide them if it's different, and so on for every other value.
But I can't even get this to work at all, and I'm not sure what I'm doing wrong.
Update: If I change the cell value, nothing happens, but if I delete all contents and add a value it gives: "Argument not optional", and it highlights this part of the code for me:
Private Sub Worksheet_Change(ByVal Target as Excel.Range)
Thank you
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If IsNumeric(Target) And Target.Address = "$D$7" Then
Select Case Target.Value
Case 0 To 90: Cell_Hider
End Select
End If
End Sub
Sub Cell_Hider(ByVal Target As Range)
If Range("$D$7").Value = "1" Then
Rows("16:26").EntireRow.Hidden = False
Else
Rows("16:26").EntireRow.Hidden = True
End If
End Sub
Your procedure Cell_Hider needs an argument but your code calls it without argument Case 0 To 90: Cell_Hider
You call Cell_Hider if the value is between 0 and 90 then that procedure needs the value to be 1 to show the rows and 0 or 2 to 90 will hide them. If you put 100 in that cell nothing happens at all. Sounds not like what you expect to me.
"1" is text not a number!
Something like the following would work:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If IsNumeric(Target) And Target.Address = "$D$7" Then
Select Case Target.Value
Case 0 To 90: Cell_Hider Target
End Select
End If
End Sub
Sub Cell_Hider(ByVal Target As Range)
If Target.Value = 1 Then
Target.Parent.Rows("16:26").EntireRow.Hidden = False
Else
Target.Parent.Rows("16:26").EntireRow.Hidden = True
End If
End Sub
Even though it doesn't look logic to me and I'm not sure what you are exactly trying to achieve.
Note that you can shorten it to
Sub Cell_Hider(ByVal Target As Range)
Target.Parent.Rows("16:26").EntireRow.Hidden = Not Target.Value = 1
End Sub
Hide/Unhide Rows on Cell Change
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sCell As Range: Set sCell = Me.Range("D7")
If Intersect(sCell, Target) Is Nothing Then Exit Sub
If IsNumeric(sCell.Value) Then
HideRows sCell
End If
End Sub
Sub HideRows(ByVal SourceCell As Range)
If SourceCell.Value = 1 Then
SourceCell.Worksheet.Rows("16:26").Hidden = False
Else
SourceCell.Worksheet.Rows("16:26").Hidden = True
End If
End Sub
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
I want to clear the contents of the cell after clicking the ok button in a message pop up window.
When the pop up window disappears, after clicking ok button umpteen times, the script terminates by throwing the below error
Run time error '-2147417848(80010108)':
Method 'Range of object'_Worksheet'Failed
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("N4:O4")
If Not Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If (Range("E9") = "" Or Range("F9") = "") Then
MsgBox "Reopen Date and Closed Date should not be populated before calculating the Benefit Begin Date and Maximum Benefit Date"
Sheets("Calculation Tool").Range("N4").Clear ----->Code written to clear the cells
Else
If (Range("N4") = "" Or Range("O4") = "") Then
Set b1 = Sheets("Calculation Tool").CommandButton22
b1.Enabled = False
Else
Set b1 = Sheets("Calculation Tool").CommandButton22
b1.Enabled = True
End If
End If
End If
End Sub
I wanted to tell #BigBen that his suggestion worked for me, but my low rep won't allow me to comment. The answer field is the only way of expression for me!
So I might as well formulate a valid answer, here it goes. :)
So I had the same problem within a Worksheet_Change event macro, in this casual event macro:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangeToCheck As Range
Set RangeToCheck = ActiveSheet.Range("O3:O32")
(above is the line that triggered randomly that Run time error '-2147417848(80010108)' you encountered; on with the script)
If Not Application.Intersect(Target, RangeToCheck) Is Nothing Then
Target.Value = VBA.Replace(Target.Value, ".", ",")
Debug.Print Target.Address, Target.Value
Else
Debug.Print "Not in RangeToCheck"
End If
End Sub
Following BigBen's link, I found that the following code works fine :
Private Sub Worksheet_Change(ByVal Target As Range)
Dim RangeToCheck As Range
On Error GoTo enableEventsOn:
Application.EnableEvents = False
Set RangeToCheck = ActiveSheet.Range("O3:O32")
Application.EnableEvents = True
On Error GoTo 0
If Not Application.Intersect(Target, RangeToCheck) Is Nothing Then
Target.Value = VBA.Replace(Target.Value, ".", ",")
Debug.Print Target.Address, Target.Value
Else
Debug.Print "Not in RangeToCheck"
End If
enableEventsOn:
Application.EnableEvents = True
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.