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
Related
I wrote code to extract data from the URL a particular page.
First time I run the code it extracts data from URL to cell C1.
I am at a point where I want to display a MsgBox whenever cell value changes.
For example:
First time I run the code "Happy" gets extracted to cell C1.
(Cell value changes, so msgbox "value changed")
The second time I run the code then Also "Happy" gets extracted to the cell C1.
(means no change, Noting happens)
The third time I run the code and "Sad" gets extracted to cell C1,
so at this point, I want a msgbox of the cell change.
I tried the below code but it shows the msgbox even when same values are changed in the cell.
For example - Cell contains text "Happy". I rewrite "Happy" in cell and press enter, so it displays msgbox of cell changed despite being same text in the cell.
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("A1:C10")
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.
MsgBox "Cell " & Target.Address & " has changed."
End If
End Sub
This uses Undo to check what the previous value of the cell was, and then compare it to the new value.
This will also not be case-sensitive, so HAPPY = HAPpy. If you want it to be case sensitive then remove the strconv functions.
Note that (any) of these procedures (including yours) will not react properly to multiple cells changing at once (like pasting in a range of cells), but you could add code to handle that however you needed to as demonstrated in the commented out lines.
But for single cells, this will do the trick:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, vNew, vOld
If Target.Cells.Count > 1 Then
MsgBox ("multiple cells changed: " & vbLf & Target.Address)
'to handle multiple cells changing at omce you'll need to loop like:
' dim c as cell
' for each c in Target.Cells
' ... etc
Exit Sub
End If
Set KeyCells = Range("A1:C10") ' cells to watch
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
vNew = Target.Value
Application.EnableEvents = False
Application.Undo
vOld = Target.Value
Target.Value = vNew
Application.EnableEvents = True
'make sure value is different (NOT case sensitive)
If StrConv(vNew, vbLowerCase) <> StrConv(vOld, vbLowerCase) Then
'do something here
MsgBox "Cell " & Target.Address & " changed" & vblf & _
"From: " & vOld & vblf & _
"To: " & vNew
End If
End If
End Sub
More Information:
MSDN : Application.Undo Method (Excel)
MSDN : Application.EnableEvents Property (Excel)
MSDN : Worksheet.Change Event (Excel)
Stack Overflow : How do I get the old value of a changed cell in Excel VBA? (Ronnie Dickson's answer)
Replace:
If Not Application.Intersect(KeyCells, Range(Target.Address))
with:
If Not Application.Intersect(KeyCells, Target)
Try it like this:
Public PrevValue
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Value <> PrevValue Then
MsgBox ("value changed")
PrevValue = Target.Value
End If
End Sub
The previous value is now stored in the global variable. When the value changes, it first checks if the value is the same as the previous value.
Edit:
If you change different cells each time, you can also use
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
PrevValue = Target.Value
End Sub
To set the value of the currenctly selected cell before the change.
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
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
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.
So I want a message to appear when a cell changes that notifies somebody when the cell is changed. The cells that change are referenced from cells in another workbook. Here is my code so far, but it only works when I manually change the cells. It doesn't work when I change the cell being referenced.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B2:P43")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Beep
MsgBox "Cell " & Target.Address & "has changed."
End If
End Sub
Try fully qualifying the Ranges, like this:
Set KeyCells = Sheet1.Range("B2:P43")