Worksheet Change Event - vba

I have the below code which I effectively want to rename worksheets based on the Value of I16. However if the target address is blank/ Nothing I wish to exit the sub. (this part of the code is not working).
If anyone could advise how I could resolve this issue it would be greatly appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("I16")
Dim WSname As String
WSname = Range("I16").Value
If KeyCells Is Nothing Then Exit Sub
Sheet23.Name = "BISSB"
Sheet25.Name = "RMIB"
Sheet26.Name = "MORIB"
Worksheets(WSname).Name = "Stage 3 V1"
End Sub

Replace:
If KeyCells Is Nothing Then Exit Sub
With:
If Trim(WSname) = "" Then Exit Sub
Explanation: you already use Set KeyCells = Range("I16") in your code, so you set your KeyCells Range, therefore it will never be Nothing.
You want to check the value of KeyCells range, and you have your WSname String variable.

Instead of
If KeyCells Is Nothing Then Exit Sub
use
If IsEmpty(KeyCells) Then Exit Sub
The ISEMPTY function can be used to check for blank cells. If cell is blank it will return TRUE else FALSE.

You are already declare and set KeyCells to "I16". This is why if condition doesnt work - because KeyCells already contains cell. Ask if WSname = "" or check other way if it contains value or no.

I think the correct way to use Change Event code is to tell the code when to be automatically triggered and perform some actions.
Right now, your code will be triggered and perform the actions defined in the code each time when any cell on the sheet gets changed.
I assume, you want to trigger the Change Event Code and perform some predefined actions only when the cell I16 gets changed and then rename the sheets as per the code. Right?
If so, you may try something like this...
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim KeyCells As Range
Set KeyCells = Range("I16")
Dim WSname As String
WSname = Range("I16").Value
If Not Intersect(Target, KeyCells) Is Nothing Then
If Target <> "" Then
Sheet23.Name = "BISSB"
Sheet25.Name = "RMIB"
Sheet26.Name = "MORIB"
Worksheets(WSname).Name = "Stage 3 V1"
End If
End If
End Sub

Related

Hide a row (in a list) based on drop-down multiple selection on each of the rows (not on a single cell)

I have a list of "activities" in column B and each of them has a drop-down list for the status in column C. For each activity I can select "Done, In progress, TBD, Cancelled". What I want is to hide a row automatically (not filtering) every time I choose the status "Cancelled" in the drop-down (located in the same row).
The code used is below:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("C2:C21")
If Target.Address <> Range("C2:C21").Address Then
Exit Sub
Cells.EntireRow.Hidden = False
Select Case Range("C2:C21")
Case "Cancelled":
Range("2:21").EntireRow.Hidden = True - ***I want to hide only those rows in which "Cancelled" is selected.***
Case "Done":
Range("2:21").EntireRow.Hidden = False - ***I want the rows to unhide if either "Done","In progress" or "TBD" is selected.***
End Select
End Sub
It's probably a terrible code for what I want to do...
Any idea on how to improve this?
Thanks a lot in advance! :)
Sara
The rng object has never been used.
If you want to check the selection is in Range("C2:C21") or not, use a Intersect function.
The If statement can be completed without an End If only if it is one-lined. Otherwise you have to put an End If at the end.
Range("2:21").EntireRow.Hidden means every rows in 2:21 are going to be hidden.
Code:
Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
For Each cel In rng
cel.EntireRow.Hidden = IIf(cel.Value = "Cancelled", True, False)
Next cel
End If
End Sub
I'm not sure the version below is fitted or not. In my opinion, generally this macro should only be run after something is changed, and we can only check the row who has been changed, other rows should remain the same state.
Private Sub Worksheet_Change(ByVal target As Range)
Dim rng As Range, cel As Range
Set rng = target.Parent.Range("C2:C21")
If Not Intersect(rng, target) Is Nothing Then
target.EntireRow.Hidden = IIf(target.Value = "Cancelled", True, False)
End If
End Sub
This is another option, skipping the If and Select Case:
Private Sub Worksheet_Change(ByVal target As Range)
Dim myRng As Range
Dim myCell As Range
Set myRng = Range("C2:C21")
If Not Intersect(myRng, target) Is Nothing Then
Cells.EntireRow.Hidden = False
For Each myCell In myRng
myCell.EntireRow.Hidden = CBool(myCell = "Cancelled")
Next myCell
End If
End Sub
The "beauty" is that the If condition is eliminated and the .Hidden is assigned to a direct evaluation of myCell = "Cancelled";
Furthermore, the code is in a worksheet, as far as the _SelectionChange event is used. Then the parent worksheet of the range could be omitted, as far as it is taking the worksheet in which the code resides. So - Target.Parent.Range could be nicely skipped.

Intersect with Target

I cannot figure out how to make the code below work. Every call results in Intersection = Nothing and the ELSE statement selected and yes rngIntersect is valid and non-empty and the intersection is not empty so the problem is with the target part.
When I debug the code and ask ? target the result is zilch. However target.column, target.row, and target.address are all correct 3,9, and $C$9 respectively).
This must be something basic but after all the looking around on different sites I have yet to come up with a solution.
I can find if the target is within range by using target.column and target.row but I cannot make the more elegant code below work. For whatever reason target seems to be 'somewhat but not completely empty'.
To emphasize, in the debug window ? target returns empty but ? target.address returns $C$9 as it should because that is the cell the user has selected and rngIntersect = $C$9:$N$9, hence Intersect = $C$9 definitely <> Nothing.
I have tried ? range(target) and ? target.range but that generates an error.
In essence, how do I make target return the range as it is supposed to, after all it is defined as a range to begin with right?
Sub OnSelectionChange(ByVal target As Range, wksChange As Worksheet)
On Error GoTo ErrorHandler
Dim rngIntersect As Range, rngTarget As Range
Set rngIntersect = wksChange.Range("RNGINTERSECT")
Set rngTarget = target
If Not Application.Intersect(rngTarget, rngIntersect) Is Nothing Then
Call WorksheetSelectionChange(target.Column, wksChange)
Else
Call MAIN.ZoomAdjust(wksChange, False)
End If
ErrorExit:
Exit Sub
ErrorHandler:
Call LogError(Err.Number, Err.Description, C_MODULE, "OnSelectionChange")
Resume ErrorExit
End Sub
I think your problem isn't from your code but from your expectation, to wit that ? Target should print something. Target is a range, and when you don't specify which property you want to print the default property will be printed which is .Value. The fact that the cell may be empty says nothing about the existence of it as a range object.
Target is a range object. Therefore you don't need to convert it into a range object, like rngTarget. As a range object, one of its properties is .Worksheet which, therefore, you don't need to pass along as an additional argument. Bear I mind that Application.Intersect also returns a range object.
Below is working code. I have stripped out anything that might confuse you, your error handlers in particular. If this kind of code ever creates an error you want to know about it immediately and not only after 3 hours of futile search.
Option Explicit
Private Sub TestIntersect()
OnSelectionChange Range("C9")
OnSelectionChange Range("C3")
End Sub
Sub OnSelectionChange(ByVal Target As Range)
Dim WksChange As Worksheet
Dim RngIntersect As Range
Set WksChange = Target.Worksheet
' Set RngIntersect = WksChange.Range("RNGINTERSECT")
Set RngIntersect = WksChange.Range("C9:N9")
If Not Application.Intersect(Target, RngIntersect) Is Nothing Then
WorksheetSelectionChange Target.Column, WksChange
Else
MAINZoomAdjust WksChange, False
End If
End Sub
Private Sub WorksheetSelectionChange(ByVal C As Long, _
Ws As Worksheet)
MsgBox "Here is WorksheetSelectionChange" & vbCr & _
"Column " & C
End Sub
Private Sub MAINZoomAdjust(Ws As Worksheet, _
ByVal TooBig As Boolean)
MsgBox "Here is MAINZoomAdjust" & vbCr & _
"TooBig = " & TooBig
End Sub
I did find the problem. The correct code should be
If Not Application.Intersect(target, wksChange.Range(wksChange.Range("RNGINTERSECT"))) Is Nothing Then
instead of
If Not Application.Intersect(target, wksChange.Range("RNGINTERSECT")) Is Nothing Then
The reason is that wksChange.Range("RNGINTERSECT") returns the string value for the range of interest, not the range itself

Type Mismatch error when range of data is changed in Excel

I have written a macro to color my cells green if the input is TRUE and red if the input to cell is FALSE.
Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Name = "Ribs" Then
If Not Intersect(Target, Range("G2:K200")) Is Nothing Then
If Target = "False" Then
Sheets("Ribs").Range(Target.Address).Style = "Bad"
ElseIf IsNumeric(Target) Then
Sheets("Ribs").Range(Target.Address).Style = "Good"
End If
ElseIf Not Intersect(Target, Range("D2:D200")) Is Nothing Then
RotateRib (Target.Address)
End If
End If
End Sub
Now the problem is that if I change the range value (for example typing TRUE in cell G2 and than drag mouse pointer from bottom right corner of G2 to G10 should copy value TRUE to range G2:G10) raises Type Mismatch error in my macro.
Debugger says the problematic line is If Target = "False" Then.
Is there a workaround the given error? Ignoring the error would probably do the job, but it's not something I'd like to do.
The problem is that you're trying to do an illegal operation. You're asking the compiler to see if the contents of G2:G10 is equal to False - you can see this by adding Debug.Print Target.Address to the top of your code and then making another attempt.
It is possible to do what you want, but you'll need more code. When comparing values, you have to do it cell by cell - you can't compare an entire range at once. Here's a rudimentary example:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If ActiveSheet.Name = "Ribs" Then
For Each c In Target
If Not Intersect(c, Range("G2:K200")) Is Nothing Then
If c.Value = "False" Then
Sheets("Ribs").Range(c.Address).Style = "Bad"
ElseIf IsNumeric(c.Value) Then
Sheets("Ribs").Range(c.Address).Style = "Good"
End If
ElseIf Not Intersect(c, Range("D2:D200")) Is Nothing Then
RotateRib (c.Address)
End If
Next c
End If
End Sub
The principal change is that we're no longer comparing against Target, we're looping through all the individual cell contents (Range objects denoted as c) of Target and comparing against those.
Again, you can verify that this works by trying this code and filling down some values:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
For Each c In Target
Debug.Print c.Address
Next c
End Sub
There's absolutely no need to check the name of active sheet, since Worksheet_Change event fires on the sheet where it's defined.
Rather iterating over each cell in the Target, you could receive the intersection and apply your settings directly.
Don't forget about that Target can contain non-contiguous ranges (accessed by Areas property). My code handles this situation, but can't say the same about RotateRib.
To sum up:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngIntersect As Range, rngArea As Range, cell As Range
Set rngIntersect = Intersect(Target, Range("G2:K200"))
If Not rngIntersect Is Nothing Then
For Each rngArea In rngIntersect.Areas
For Each cell In rngArea
cell.Style = IIf(cell, "Good", "Bad")
Next
Next
End If
Set rngIntersect = Intersect(Target, Range("D2:D200"))
If Not rngIntersect Is Nothing Then RotateRib (rngIntersect)
End Sub

Excel VBA Worksheet_Change

I have code that checks for text in a range of cells and opens a MsgBox
The code works well until I delete a range of data both from using a macro for ClearContents and selecting a range of cells and using the delete button. No error if I delete cell contents one cell at a time.
The original code would trigger the MsgBox for every change; I just want it to trigger based on the entry of "Not Met" from a pick list.
The error I get is this:
Run-time error '13': Type mismatch
Following is the modified code:
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("E3:E41")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If Target.Value = ("Not Met") Then
MsgBox "Make sure you enter Gaps, Actions and a Priority Rating"
End If
End If
End Sub
There is no real need to have a Range variable to keep the the Range("E3:E41"), you can do it directly with If Not Intersect(Range("E3:E41"), Target) Is Nothing Then.
Note: Since Target is a Range, there is no need to use it with Range(Target.Address) , Target alone will do it.
Code (short version)
Private Sub Worksheet_Change(ByVal Target As range)
If Not Intersect(Range("E3:E41"), Target) Is Nothing Then
' Display a message when one of the designated cells has been changed
If Target.Value = ("Not Met") Then MsgBox "Make sure you enter Gaps, Actions and a Priority Rating"
End If
End Sub
This should give you what you are after:
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("E3:E41")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
If Target.Count = 1 Then
If Target.Value = ("Not Met") Then
MsgBox "Make sure you enter Gaps, Actions and a Priority Rating"
End If
End If
End If
End Sub

Macro "trigger on cell change" is also triggered when inserting rows

I'm currently using VBA to check when cells in a certain column are changed, so I can call a different macro to sort them. This works wonderfully, except that it also triggers whenever I insert a new row. So using IsEmpty I added a check to see if the cell in question isn't empty. But I'm obviously doing it wrong, since my macro is still called whenever I insert a row. What am I doing wrong?
The VBA that triggers on cell changes:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
If Not IsEmpty(KeyCells) Then
Call SortByDate
End If
End If
End Sub
You might filter out row insertions by checking the number of cells that received a change. In the case of a row insertion, this is greater than or equal to the worksheet's columns.count. If you are changing anything on that worksheet use application.enableevents = false before starting to change anything and application.enableevents = true before leaving the sub.
Private Sub Worksheet_Change(ByVal Target As Range)
' exit immediately on row insertion
If Target.CountLarge >= Columns.Count Then Exit Sub
If Not Intersect(Target, Columns(1)) Is Nothing Then
'escape route
On Error GoTo bm_Safe_Exit
'don't declare or Set anything until you know you will need it
'(this isn't really terribly necessary)
Dim KeyCells As Range
Set KeyCells = Range("A:A")
If Application.CountA(KeyCells) Then 'is there ANYTHING in A:A?
Application.EnableEvents = False
Call SortByDate
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Failing to disable event handling and subsequently changing anything on the worksheet will trigger another change event and the Worksheet_Change event macro will try to run on top of itself.