When i click a button on my worksheet the below event is called.
I get the error 'Type mismatch'
I suspect I need another if statement to stop the original IF being evaluated if the event is due to a button being pressed?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("D4") Then 'Error is here
End If
End Sub
This
If Target = Range("D4") Then
is equivalent to this
If Target.Value = Range("D4").Value Then
which clearly is not what you want. You will probably get the error you describe if Target.Value happens not to be of the same type as Range("D4").Value.
What you want is this:
If Not Intersect(Target, Range("D4")) Is Nothing Then
EDIT I just managed to reproduce your error. It occurs if the Target range is of a different size than Range("D4") i.e. spans more than one cell. As #Dick Kusleiska notes, it also occurs if one of the two is an error value. Maybe it's triggered by other things as well, I don't know. Anyhow, the point is, your If condition is wrong!
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("D4")) Is Nothing Then
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
EDIT:
I would also recommend using Error handling and setting the .EnableEvents to false to avoid and possible endless loops :)
Related
I am trying to have a column automatically format when a fraction is input. Excel by default had been converting the fraction 5/2 to 2.50, which is fine in certain circumstances, but I actually needed it to input what is the Starting Price of a selection, which means if 5/2 is input, the actual calculation would be =5/1+1 (3.50), so it adds in the original stake of 1 as well. 15/8 would be =15/8+1 (2.88) and so on.
In the worksheet, I have the following VBA code.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo err_handler
Application.EnableEvents = False
If Target = Empty Then GoTo exit_handler
If Not Intersect(Target, Columns("Q")) Is Nothing Then
With Target
.Formula = Evaluate(.Formula & "+1")
End With
End If
exit_handler:
Application.EnableEvents = True
Exit Sub
err_handler:
MsgBox Err.Number & ": " & Err.Description
Resume exit_handler
End Sub
OK, resolved thanks so much. This seems to work perfectly
I am not sure you understood how exactly to use the function, even if I could be wrong... In order to work as you wish, you must proceed in the next way:
Create a Worksheet_Change event for the sheet where you intend to work. It will only call your above function.
Private Sub Worksheet_Change(ByVal Target As Range)
Starting_Price Target
End Sub
If you do not know how to create such an event, do not hesitate to ask;
Then you must put your above code in the same sheet module. Exactly as it is or slightly modified to use only VBA (without RegExp):
Private Sub Starting_Price(ByVal Target As Range)
On Error GoTo err_handler
Application.EnableEvents = False
If Target = Empty Then GoTo exit_handler
If Not Intersect(Target, Columns("P")) Is Nothing Then
With Target
If Target.HasFormula Then
.Formula = .Formula & "+1"
End If
End With
End If
exit_handler:
Application.EnableEvents = True
Exit Sub
err_handler:
MsgBox Err.Number & ": " & Err.Description
Resume exit_handler
End Sub
Take care to input (only in column P:P) your fraction like formula:
= 5/2;
Be sure that your Excel workbook is a .xlsm type.
Sorry, may have posted the answer above where the original code was.
This code seemed to solve the problem, so thanks very much for the input
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo err_handler
Application.EnableEvents = False
If Target = Empty Then GoTo exit_handler
If Not Intersect(Target, Columns("Q")) Is Nothing Then
With Target
.Formula = Evaluate(.Formula & "+1")
End With
End If
exit_handler:
Application.EnableEvents = True
Exit Sub
err_handler:
MsgBox Err.Number & ": " & Err.Description
Resume exit_handler
End Sub
I create a new module and insert this code:
Sub test()
Set wsData = ThisWorkbook.Worksheets("Data")
sCount = wsData.Columns(14).SpecialCells(xlCellTypeBlanks).Count
msgbox sCount
End Sub
In the worksheet "Data", I have this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Not Intersect(Target, Range("K:M")) Is Nothing And Target.Value <> "" Then
'code
End if
End if
End Sub
When I run the test() sub, I get a type mismatch error on If Not Intersect(Target, Range("K:M")) Is Nothing, as Target wrong type.
Why this is happening?
Why is test triggering the Change Event?
I dont get the same error if manually filter column 14 of my Data sheet to leave only the blank cells!
The problem with the type mismatch, is that the Target.Cells is more than one cell. Thus, the Target.Value <> "" throws type mismatch, because multiple cells cannot be compared to "". See the MsgbBox with the number of cells:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.CountLarge = 1 Then
If Target.Cells.CountLarge > 1 Then MsgBox Target.Cells.CountLarge
If Not Intersect(Target, Range("K:M")) Is Nothing And Target.Value <> "" Then
'code
End If
End If
End Sub
Based on the business logic there could be several solutions.
The easiest one is to write
If Target.Cells.CountLarge > 1 Then Exit Sub in the _SelectionChange event.
Another way is to disable events around
sCount = wsData.Columns(14).SpecialCells(xlCellTypeBlanks).Count like this:
Sub TestMe()
Set wsData = ThisWorkbook.Worksheets("Data")
Application.EnableEvents = False
sCount = wsData.Columns(14).SpecialCells(xlCellTypeBlanks).Count
Application.EnableEvents = True
msgbox sCount
End Sub
I almost closed this question as a duplicate.
I will answer both your questions but in the reverse order so that you can understand it better.
Why is test triggering the Change Event?
I have explained it in SpecialCells causing SheetSelectionChange event in Excel 2010
When I run the test() sub, I get a type mismatch error on If Not Intersect(Target, Range("K:M")) Is Nothing, as Target wrong type.
Why this is happening?
When the procedure Test triggers the Worksheet_SelectionChange event, your code will fail on the line
If Not Intersect(Target, Range("K:M")) Is Nothing And Target.Value <> "" Then
It is because Target.Value <> "" is the culprit as SpecialCells(xlCellTypeBlanks).Count may return multiple cells.
If you break the above line in 2 lines then you will not get an error
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("K:M")) Is Nothing Then
If Target.Value <> "" Then
'code
End If
End If
End Sub
This question already has answers here:
Why MS Excel crashes and closes during Worksheet_Change Sub procedure?
(3 answers)
Closed 4 years ago.
I have reworked this macro for two days in a load of different ways to try to prevent steps from repeating but the range G2 step seems to run 3 or 4 times and the range G3 2 or 3 times. Does anyone have any ideas??
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Exit Sub
End If
End Sub
Your Worksheet_Change has succumbed to three of the most common mistakes in an event driven worksheet/workbook sub procedure.
You are not disabling events while making modifications to the worksheet. Each change triggers another event and the Worksheet_Change tries to run on top of itself over and over until it crashes.
Target could be a single cell or many cells. You need to deal with the possibility of Target being many cells by using Intersect to only get the affected cells within your range of possibilities.
If you disable events for any reason, make sure to provide error control that turns them back on if everything goes south. Typically, this can be done just before exiting the Worksheet_Change but not if you are going to use Exit Sub.
Here is my version of your procedure.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4, G2:G4")) Is Nothing Then
On Error GoTo Safe_Exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("D4, G2:G4"))
Select Case trgt.Address(0, 0)
Case "G2"
Range("G3:G4") = Application.Transpose(Array("Division", "Team"))
'call check is below
Case "G3"
Range("G4") = "Team"
'call check is below
Case "D4", "G4"
'call check is below
End Select
Next trgt
Call check
End If
Safe_Exit:
Application.EnableEvents = True
End Sub
Your code is in the Worksheet_Change event. Every time the worksheet is changed this event fires, including when your code changes it
Range("g4").Value = "Team"
Thus you're stuck in a potentially infinite loop. To avoid this disable events before making any changes
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False ' this turns events off
If Not Intersect(Target, Target.Worksheet.Range("G2")) Is Nothing Then
Range("g4").Value = "Team"
Range("g3").Value = "Division"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G3")) Is Nothing Then
Range("G4").Value = "Team"
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("G4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
If Not Intersect(Target, Target.Worksheet.Range("D4")) Is Nothing Then
Call check
Application.EnableEvents = True
Exit Sub
End If
Application.EnableEvents = True
End Sub
You might need to enable or disable events within the subs you're calling too.
BTW I'd check if you really need those Exit Subs, if not you can just disable events once at the start and re-enable again at the end.
I have code for hiding and unhiding rows in my sheet based on changing the value in my dropdown. Every time I change the dropdown I get Run-Time error of '1004'. I had a private Sub before and changed it to a Sub but that doesn't seem to be the solution.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Target.Parent.Range("L6")
If Target.Count > 1 Then Exit Sub
If Intersect(Target, rng) Is Nothing Then Exit Sub
Application.Run "dynamic_hide"
End Sub
Sub dynamic_hide()
If Target.Range = "$S$9:$S$51" Then
If Target.Range = 0 Then Rows("F9:T51").EntireRow.Hidden = True
If Target.Value <> 0 Then Rows("F9:T51").EntireRow.Hidden = False
End If
End Sub
You have a few problems going on here:
First, the default property of a Range object is Value, so Target.Range = "$S$9:$S$51" will always be false. Use Target.Address instead.
Second, don't use Application.Run to call Subs from the same VBProject. Use Call instead.
Third, you've not let the sub dynamic_hide know what Target is since Target is only a parameter of the Worksheet_Change event subroutine. You can solve this by declaring your sub like Sub dynamic_hide(ByVal Target As Range) And then you can use it: Call dynamic_hide(Target)
Lastly, since Target is a range you don't need to use Target.Range since Target is a range so you can simply omit every .Range from Target.Range Target.Parent.Range is fine.
I have made a spreadsheet which a user can enter a postcode and a quantity into 2 cells and I have other cells doing calculations and displaying the results.
I have added some VBA to prevent anyone from deleting rows and columns but I would like to prevent deletion of any cell within a range but also allow a user to make changes to certain cells but also prevent editing of cells with formula in there.
In cell E4, the user can enter a postcode. In E6, the user can enter a quantity. These can be edited but not deleted. E8:E9 and E11:E14 are all drop down lists (validation) which hold data from lists. These can be changed using the drop down but not deleted.
L10:L14, L16, L23:L27, L29, L30:L33 can all have their data edited but not deleted.
What would the VBA for this look like? I guess it would use the Worksheet_Change() event.
Is this what you are trying? Users can edit cell E4 and E6 but they cannot leave it empty. I am also assuming that the cell are not empty before hand.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("E4")) Is Nothing Then
If Len(Trim(Range("E4").Value)) = 0 Then Application.Undo
ElseIf Not Intersect(Target, Range("E6")) Is Nothing Then
If Len(Trim(Range("E6").Value)) = 0 Then Application.Undo
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
FOLLOWUP
Thanks that is what i want to do. What about the other ranges? Is it just a case of loads of IF THEN or can we use a CASE and loop through? – AdRock 2 mins ago
Add/Delete cell addresses from below as applicable.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("E4,E6,E8:E9,E11:E14,L10:L14,L16,L23:L27,L29,L30:L33")) Is Nothing Then
If Len(Trim(Target.Value)) = 0 Then Application.Undo
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
You are partly right but Worksheet_Change() is triggered after the change, so after the deletion.
What I'd do is to have a hidden sheet to store the values entered by the user and then you can check in Worksheet_Change() whether the new value is empty (deleted) or not.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$4" Then
' check the previous value on the hidden sheet here, if changed, then save it, if empty, then restore it
End If
End Sub