Data Validation and Worksheet Change Event - vba

I use a VBA macro to query a database and build a list of available projects when a workbook is opened using the workbook activate event. I have project numbers and project names that are combined into two separate data validation lists and applied to two cells. The worksheet change event tests for changes in these cells, splits their data validation lists into arrays, and chooses the corresponding project information from the other array. For instance, if I pick a project number, the worksheet change event finds the project number's position in the project number array, and then picks the project's name from the name array based on position.
This works perfectly whenever a value is selected from the drop down, but I run into problems when values outside the list are entered. For instance, if I enter a blank cell I may get the data validation error or I may get a type mismatch when I use match to find the entered value in the array. I have an error handler to handle the type mismatch, but I would like the data validation error to trigger every time instead. Another problem is that Events will sometimes be disabled. This is much more serious because users will not have a way to turn these back on.
On top of this, I cannot figure out where or how this is happening. I can't replicate how the Events are disabled using breaks because duplicating the steps that lead to the events being disabled with breaks in place only leads to my error handler. However, when breaks aren't applied, the error handler will sometimes fail to trigger and the events will be disabled. Since I'm disabling events just before I parse arrays, I'm thinking the worksheet change fails at the Loc=Application.Match(Target.Text, NumArr, 0) - 1 line, but I can't figure out why no error would be triggered. At the very least, I should get a message with the error number and description, and events should be re-enabled.
Can anyone advise on the interaction between worksheet change and data validation? What is the call order here? Any other advice? Anything I'm missing?
ETA: I've Googled this, but I haven't found anything that helps. Everything that comes up is about working the data validation into worksheet change, nothing about the interaction or call order.
ETA #2: After trying the experiment in the answer below (Thanks Gary's Student), this gets a little more odd. If I choose "Retry" and choose the old, default value, I get the old value three times. If I hit delete, I get a space in the message box, but only one message box. Then the cell is left blank. I can put DV into a loop by clicking "Retry" and accepting the space. The DV error will come up until I click cancel. Then I will get a series of empty text message boxes, one for each time I retried the empty cell. If I start off with a listed value, clear the cell with backspace, click "Retry," and try to select another value, the worksheet change event fails at Intersect 3 times. I think the answer below sheds more light on what is going on, but it does bring up more questions also.
Here is the code I have:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NumArr() As String
Dim ProjArr() As String
Dim Loc As Integer
On Error GoTo ErrHandler:
If Target.Address = "$E$4" Then
'Disable events to prevent worksheet change trigger on cell upates
Application.EnableEvents = False
'Parse validation lists to arrays
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(1, 0).Validation.Formula1, ",")
'Change error handler
On Error GoTo SpaceHandler:
'Determine project number location in array
Loc = Application.Match(Target.Text, NumArr, 0) - 1
'Change error handler
On Error GoTo ErrHandler:
'Change cell value to corresponding project name based on array location
Target.Offset(1, 0) = ProjArr(Loc)
'Unlock cells to prepare for editing, reset any previously imported codes
Range("C8:G32").Locked = False
'Run revenue code import
RevenueCodeCollector.ImportRevenueCodes
'Re-enable events
Application.EnableEvents = True
End If
If Target.Address = "$E$5" Then
Application.EnableEvents = False
NumArr = Split(Target.Validation.Formula1, ",")
ProjArr = Split(Target.Offset(-1, 0).Validation.Formula1, ",")
Loc = Application.Match(Target.Text, NumArr, 0) - 1
Target.Offset(-1, 0) = ProjArr(Loc)
Range("C8:G32").Locked = False
RevenueCodeCollector.ImportRevenueCodes
Application.EnableEvents = True
End If
Exit Sub
ErrHandler:
MsgBox Err.Number & " " & Err.Description
Application.EnableEvents = True
Exit Sub
SpaceHandler:
MsgBox "Pick a project from the dropdown.", vbOKOnly, "Error"
Application.EnableEvents = True
End Sub

You have a very open-ended question...........not having the time to do a full whitepaper, here is a simple experiment. I use the Event code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A1 As Range, rINT As Range
Set A1 = Range("A1")
Set rINT = Intersect(A1, Target)
If rINT Is Nothing Then Exit Sub
MsgBox A1.Value
End Sub
and in A1, I setup DV as follows:
If I use the drop-down, I get the value entered and I also get the MsgBox. However, if I click on the cell and type some junk what happens is:
the DV alert occurs and I touch the CANCEL Button
I get 2 MsgBox occurrences, each with the original contents rather than the attempted junk !!
I have absolutely no idea why the event is raised since the cell is not actually changed, let alone why the Event is raised twice !! It is almost as if
the event is raised on junk entry, but the DV alarm has precedence, the DV reverse the entry and another event is raised, and finally both events get processed.
Hopefully a person smarter than me will chime in.

With ref to the query, Workaround for the DV and change event is managed.
Public strRange As String
Public bCheck As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
If bCheck Then Exit Sub
MsgBox "Correct Entry!"
strRange = Target.Address
bCheck = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address <> strRange Then bCheck = False
End Sub
http://forum.chandoo.org/threads/multiple-worksheet-change-event-with-data-validation.32750

Related

Command button in a userform to delete multiple rows depending on selection in listbox

I am currently working on a userform which has a "Clear Process" command button. The idea is that my userform has a listbox which will list all of the current processes.
From here the user will select which process(es) he/she would like to clear from the worksheet (delete all rows relating to the process).
Embedded in the code I have used the word "Lisa" as a point of reference for the previous userform to know which cell the Process Name should be, using the offset function.
I would like to be able to use the word "Lisa" once the process to be deleted has been identified by the user. This would always be the row where "Lisa" is found and 19 rows below.
I have started some code but when trying to find "Lisa" depending on the selection made by the user I came across an issue.
Private Sub ClearButton_Click()
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
'hold in memory
Application.ScreenUpdating = False
'check for values
If Emp1.Value = "" Or Emp2.Value = "" Then
MsgBox "There are no processes to delete"
Exit Sub
End If
'confirm process should be deleted
cDelete = MsgBox("Are you sure you want to delete this process?", vbYesNo)
If cDelete = vbYes Then
'find the process to be deleted
'''''''set findvalue =
'''''''delete entire process
findvalue.EntireRow.Delete
End If
End Sub
Hopefully this is enough information, any help would be greatly appreciated :)
If you use Named ranges for your processes, which seems to be almost mandatory in your case, then you can do the following:
Sub DeleteNamedRange(rngName As String)
Range(rngName).ClearContents
ThisWorkbook.Names(rngName).Delete
End Sub
Invoke the Sub this way:
Call DeleteNamedRange("Lisa")
Something as small as this one would set a range to a found value and delete it:
Public Sub TestMe()
Dim findValue As Range
Set findValue = Selection.Find("Lisa")
findValue.EntireRow.Delete
End Sub
As a good practice, you may check whether the findValue is not nothing before deleting. Thus, you avoid an error:
If Not findValue Is Nothing Then
findValue.EntireRow.Delete
End If
And if you want to make the code even one step further, keep in mind that the default value of the argument After in Find() is the first cell. Thus, Find() always start looking from the second cell. To avoid this, and to start looking from the first cell, it is considered a good practice to pass the After:= argument explicitly:
Public Sub TestMe()
Dim findValue As Range
Dim selectedValue As Range
Set selectedValue = ActiveSheet.Range(Selection.Address)
With selectedValue
Set findValue = .Find("Lisa", after:=.Cells(.Cells.Count))
End With
If Not findValue Is Nothing Then
findValue.EntireRow.Delete
End If
End Sub
To make the code even more "interesting", one may decide to check whether a range is selected (a shape can be also selected). Thus, the TypeName(Selection) can be used with something like this:
If TypeName(Selection) <> "Range" Then
MsgBox "Range is not selected!"
Exit Sub
End If
Range.Find MSDN

VBA User form gives warning if duplicate is found

I think I need to try and make this question easier. So here goes;
I am creating a User form in Excel that will act as a data capture form.
In this form I have a Textbox called PolBX In this a is placed and at submission data in PolBX is copied into the "G" column using this code
Cells(emptyRow, 7).Value = PolBX.Value. This works great.
I discovered that there may be instances where the User may accidently use the same Unique Id number twice. so I am trying to find out how to code it that after the User has entered the Unique Id number it would check for that string (Consists of letters and numbers). if it finds the string already in the 7th column(G) it must say something like
"Policy number already Used, please try again"
I am thinking I will need to use the following subroutine
Private Sub PolBX_AfterUpdate()
End Sub
Can some please assist with creating this code...
Also can you please explain what you are doing as I started VBA about a week ago
You can add the following code to search for your policy number, and if nothing found then PolLookup = Nothing.
Option Explicit
Sub Test()
On Error GoTo ErrHandler
Dim ws As Worksheet, PolLookup As Range, LookupRng As Range
Set ws = ThisWorkbook.Worksheets(1)
'This is the range you want to search, it can be a long range
'or it can be a single cell.
Set LookupRng = ws.Range("A:A")
'Range.Find is looking for your value in the range you specified above
Set PolLookup = LookupRng.Find("YourLookupValue")
'PolLookup = Nothing if it didn't find a match, so we want to use
'If <NOT> Nothing, because this suggests .Find found your value
If Not PolLookup Is Nothing Then
Err.Raise vbObjectError + 0 'Whatever error you want to throw for finding a match
End If
'Exit before you reach the ErrHandler
Exit Sub
ErrHandler:
If Err.Number = vbObjectError + 0 Then
'Handle your error. Do you want to stop completely? Or have the
'User enter a new value?
End If
End Sub
Basically, after your user enters their value in your UserForm, just make a call to this Sub to do a quick lookup.
Playing around I discovered a Much easier way! I included a Button with he following code attached
Private Sub CommandButton8_Click()
Search = PolBX.Text
Set FoundCell = Worksheets("sheet1").Columns(7).Find(Search,LookIn:=xlValues, lookat:=xlWhole)
If FoundCell Is Nothing Then
MsgBox "No duplicates found"
Else
MsgBox "This policy has already been Assessed" & "Please assess a different case"
PolBX.Value = ""
End If

VBA Nested IF statement

I want to show a message box when a specific cell has a particular value in it. I have done this with the following code;
If Range("P8") = "Y" Then
MsgBox "Message here"
End If
This is within the Worksheet_Change sub so shows the message box everytime another cell value changes. I have tried to get around this by adding a boolean variable, set to true when the messagebox has been shown the first time;
If Range("P8") = "Y" Then
If messageshown = False Then
messageshown = True
MsgBox "Message here"
Else
End If
Else
End If
However the message box still shows every time I change a cell in the worksheet. I have a feeling it';s to do with the way I have written the nested if statement but have tried various different ways and orders of where I place else and end if but to no avail.
Use the Target argument instead - this refers to the actual cell being changed, which is what you are interested in. Test the address of the Target to see if it's the cell you need and then act accordingly. This will stop the message showing when another cell is changed.
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Address = "$P$8" And .Value = "Y" Then MsgBox "Message here"
End With
End Sub
Try this code, it first checks which cell is changed, if it is anything but P8, it will not pop the messagebox.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$P$8" Then
If Range("P8") = "Y" Then
MsgBox "This works"
End If
End If
End Sub
As pointed out by Macro Man, there is a more optimal, more efficient option.

Macro launching when a cell value changes due to a formula not by the user

I would like my Macro to launch whenever a value in a cell containing a formula changes.
i.e. the user is modifying another cell thus changing the value of the cell in question.
I have noticed that using the statement (found herein), only works if the user modifies the cell itself but not if the cell changes automatically - due to a formula as specified above.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A20")) Is Nothing Then ...
Any thoughts??
I tried to follow the answers from this question "automatically execute an Excel macro on a cell change" but it did not work...
Thanks in advance :)
A possible work-around comes from the fact that, to change a value, the user needs to change the selection first. So I would:
1) Declare a global variable called "oldValue" on top of the WS source code module:
Dim oldValue As Variant
2) Register the old value of your formula before the user types anything (let's say it's in Range("A4"), I let you adapt with the others):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Range("A4")
End Sub
3) Check if the change has affected the formula in the Change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A4") <> oldValue Then
MsgBox "User action has affected your formula"
End If
End Sub
I've tested with a simple sum, I'm able to write cells that are not involved without any prompt but if I touch one of the cells involved in the sum the MsgBox will show up. I let you adapt for multiple cases, for user adding/removing rows (in that case I suggest to name the ranges containing the formulas you want to track) and the worksheet references.
EDIT I'd like to do it at once, not by going through 2 processes, is it possible? The problem is my macro involves a range containing more than one cell so it will be hard to store old values for 10 cells.
If ranges are next to each other, then instead of using a variable you can use a collection:
Dim oldValues As New Collection
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
For j = 1 To 10
oldValues.Add Range("A" & j).Value
Next j
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
For j = 1 To 10
If Range("A" & j).Value <> oldValues(j) Then
MsgBox "The value of Range(A" & j & ") has changed"
End If
Next j
End Sub
Of course, if ranges are not close to each other, you can just store them anyway in the SelectionChange event like this:
oldValues.Add Range("A1").Value
oldValues.Add Range("B7").Value
'...
and if you done this ONCE, with 10 ranges only, it should be a reasonable solution to your problem.
You said, "I would like my Macro to launch whenever a value in a cell containing a formula changes..."
If having your code run whenever a cell containing a formula is recalculated (which is not exactly what you asked for), one solution might be to create a VBA function that simply returns that value passed to it, plus does whatever else you want to do when the formula is recalculated...
Public Function Hook(ByVal vValue As Variant) As Variant
Hook = vValue
' Add your code here...
End Function
...then "wrap" your formula in a call to this function. For example, if the formula you are interested in is =A1+1, you would change this to =Hook(A1+1), and the Hook function would be called whenever A1+1 is recalculated (for example, when the value in A1 changes). However, it is possible that recalculating A1+1 will yield the same result and still call the Hook function (for example, if the user re-enters the same value in A1).
You can have a go at this:
First, in a Module Code declare a Public Variable.
Public r As Range, myVal '<~~ Place it in Module
Second, initialize your variables in Workbook_Open event.
Private Sub Workbook_Open()
Set r = Sheet1.Range("C2:C3") '<~~ Change to your actual sheet and range
myVal = Application.Transpose(r)
End Sub
Finally, set up your Worksheet_Calculate event.
Private Sub Worksheet_Calculate()
On Error GoTo halt
With Application
.EnableEvents = False
If Join(myVal) <> Join(.Transpose(r)) Then
MsgBox "Something changed in your range"
'~~> You put your cool stuff here
End If
myVal = .Transpose(r)
forward:
.EnableEvents = True
End With
Exit Sub
halt:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume forward
End Sub
Above will trigger the event when values in C2:C3 changes.
Not really very neat but works in detecting changes in your target range. HTH.
Declaring a module -level variable like Matteo describes is definitely one good way to go.
Brian 's answer is on the right track with regards to keeping all is the code in the same place, but it's missing one critical part : Application.Caller
When used in function that is called by a single cell, Application.Caller will return the Range object of that cell. This way you can store the old value within the function itself when it is called, then once you're done with calculating the new value you can compare it with the old and run more code as required.
Edit: The advantage with Application.Caller is that the solution scales in and of itself, and does not change no matter how the target cells are arranged (I.e. Continuous or not).

Excel - Run-time error '1004': Unable to set the hidden property of the range class

I am new to scripting and I am trying to improve a existing Macro. I recorded a macro to remove duplicate and added it in a Main function which calls some other functions, but I am getting this error when I add the macro I recorded:
Run-time error '1004': Unable to set the hidden property of the range class
The code looks like
Private Sub Worksheet_Change(ByVal Target As Range)
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
End Sub
Some possible answers:
You have a comment in one of the selected cells
You have some drawn objects which don't resize with text
Your worksheet is protected
When you set a breakpoint on the first line of the event handler, and then press F8 to step through the macro, I'm assuming it crashes on the line:
Range("A48:A136").EntireRow.Hidden = True
When people say "You have a comment in one of the selected cells", keep in mind that THE COMMENT CAN BE IN A DIFFERENT COLUMN.
If a comment box is over the column you're trying to hide (like if you're hiding every column to the right and you have comments in a completely different column), this is the error you'll get.
If you try to manually hide the column, you'll get a different confusing error which is something along the lines of "hiding this column will push an object off of the sheet."
The comment box a few columns over is the object.
^ This would have saved me about 40 minutes of debugging.
try this :)
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveWorkbook.Unprotect "password_here"
Dim changed As Range
Set changed = Intersect(Target, Range("J15"))
If Not changed Is Nothing Then
Range("A48:A136").EntireRow.Hidden = True
Select Case Target.Value
Case "Agriculture"
Range("A48:A96").EntireRow.Hidden = False
Case "Commercial"
Range("A97:A136").EntireRow.Hidden = False
Case "MDP"
Range("A48:A61").EntireRow.Hidden = False
End Select
Range("J15").Select
End If
ActiveWorkbook.Protect "password_here"
End Sub
This should work for you :)