I have a protected workbook. It works perfectly fine. Until we counter the below error.
Data validation is used on one of the cells, where the user is not allowed to enter a date before 01/01/1970 and it throws an error when we do so.
But the concern is when we click on "Retry or cancel". I get runtime error which is causing the problem. Once we encounter the error it affects other fields with VBA enabled(VBA on other fields will not work until we close and open a fresh spreadsheet). How do we handle such error?
Please suggest
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim myValue
With Application
myValue = Target.Formula
.Undo
Target.Formula = myValue
End With
Application.CutCopyMode = False
If Not Intersect(Target, Range("E43")) Is Nothing Then
With Range("E44")
If Target.Value = "Specific Number of Days" Then
.Locked = False
.Activate
Else
'This handles **ANY** other value in the dropdown
.Locked = True
'.Clear
End If
End With
ElseIf Not Intersect(Target, Range("E30")) Is Nothing Then
If Target.Value = "YES" Then Call Notify Else Call NotifyUser
ElseIf Not Intersect(Target, Range("E31")) Is Nothing Then
If Target.Value = "YES" Then Call Delta Else Call DeltaUser
End If
Application.EnableEvents = True
End Sub
Related
So far, I have an excel sheet that displays information about parts and in column 'H' there is an initial column that when someone puts their initials in that column it indicates that the part is finished. The row with the new initials should go to the bottom of the data. However, before this happens I have already set up a userform, 'UserForm2' in which the user will put in a password. So, if I could get some guidance on how to go about doing that when they press the 'OkayButton', that would be amazing!
Edit: I have tried moving it down with the worksheet change event, but I can't figure out how to get it to work.
Edit2(defunct): I have sort of figured it out; However, the code that I've indicated below I have added is giving me a invalid qualifier error.
Edit3: Some progress! The newly changed code below does what I it to now; However the 'userform2' keeps popping up after it has been copied to the bottom, I'm not entirely sure why and if anyone would happen to know how to fix it and could tell me that would be much appreciated!
Edit4: It works!... For the most part. The error that was in the previous edit is still popping up. Again, the updated code is below.
Userform2:
Private Sub CancelButton_Click()
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Unload Me
End Sub
Private Sub OkayButton_Click()
IniPass = "pass"
If Me.PasswordIn.Value = IniPass Then
Unload Me
Else
MsgBox "Incorrect Password"
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Please use the Cancel button to close the password window!"
End If
End Sub
Sheet1(LookUp):
Private Sub Worksheet_Change(ByVal Target As Range)
LooupValue = Target.Value
part = Application.VLookup(LooupValue, MasterSheet.Range("A:AO"), 7, False)
desc = Application.VLookup(LooupValue, MasterSheet.Range("A:AO"), 9, False)
cust = Application.VLookup(LooupValue, MasterSheet.Range("A:AO"), 10, False)
due = Application.VLookup(LooupValue, MasterSheet.Range("A:AO"), 13, False)
If Not Application.Intersect(Range("A:A"), Target) Is Nothing Then
Range(Target.Address).Offset(0, 3).Value = part
Range(Target.Address).Offset(0, 4).Value = desc
Range(Target.Address).Offset(0, 5).Value = cust
Range(Target.Address).Offset(0, 6).Value = due
End If
If Not Intersect(Target, Range("H:H")) Is Nothing Then
UserForm2.Show
Application.EnableEvents = False
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Sheet1.Rows(Target.Row).Cut Sheet1.Rows(lastRow).Offset(1, 0)
Application.EnableEvents = True
Application.CutCopyMode = False
On Error Resume Next
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
End Sub
Userform2 is probably popping up because this If Not Intersect(Target, Range("H:H")) Is Nothing Then is always evaluating to true. Does the range being passed into worksheet change always contain "H"?
Whenever I run this, it is showing me Type mismatch Error (in If Target.Value = "CustomChoice")
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "CustomChoice" Then
Range("P12").Value = "Enter Dates"
Range("P13").Interior.Color = vbGreen
Range("R13").Interior.Color = vbGreen
Else
Range("P12:R13").Clear
Range("Q10").Select
End If
End Sub
This happens because this event fires again in the line Range("P12:R13").Clear. But when this line activates, Target.Address=P12:R13. And the .value property can't be used like you are doing if the range is more than 1 cell.
So you need to modify your code to avoind triggering again this event when Worksheet changes during execution. Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False 'deactivate events
If Target.Value = "CustomChoice" Then
Range("P12").Value = "Enter Dates"
Range("P13").Interior.Color = vbGreen
Range("R13").Interior.Color = vbGreen
Else
Range("P12:R13").Clear
Range("Q10").Select
End If
Application.EnableEvents = True 'activate events
End Sub
Using the following code to auto upper two columns,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) _
Is Nothing) Then
With Target
Application.EnableEvents = False
.Value = UCase(.Value)
Application.EnableEvents = True
End With
End If
End Sub
Works perfectly, the problem is, if a user selects multiple cells, and hits delete, it errors, then the user hits End and the function no longer works. protected. Run-time error 13, type mismatch.
Doesn't matter if the cell is empty or not, still get the error.
Thanks in advance.
The answer of #ScottHoltzman solves the issue of the current problem, where an error is raised when you apply UCASE to an Array. When the Target range has more than one cell its .Value is an array, and UCase does not accept an array parameter.
Your routine will exit this line (.Value = UCase(.Value)) and will miss the next line that resets Application.EnableEvents = True. After that, you end up working with events disabled, so all your event handling routines will stop working, not only this one (in case you had other such routines).
To avoid these situations the good approach is to implement proper error handling in event handlers, following this structure
Sub my_Handler()
On Error Goto Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False ' etc..
''''''''''''''''''''''''''''''''''
'
' normal code of the routine here
'
''''''''''''''''''''''''''''''''''
Cleanup:
if Err.Number <> 0 Then MsgBox Err.Description
Application.EnableEvents = True, Application.ScreenUpdating = True ' etc..
End Sub
To apply it to your routine:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False ' etc..
If Not (Application.Intersect(Target, Range("C2:P5000")) Is Nothing) Then
Target.value = UCase(Target.value)
End If
Cleanup:
If Err.Number <> 0 Then msgBox Err.Description
Application.EnableEvents = True: Application.ScreenUpdating = True ' etc..
End Sub
Importantly, don't use this structure automatically for all you routines, only Event handlers or eventually macros ythat you would invoke from the GUI. Other routines are usually called from these handlers or macros, so you can write them normally.
I tried putting this in a comment to the answer, but was too long, so sorry..
#a-s-h #a.s.h
This one worked the best, with a slight modification. Thanks!
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False ' etc..
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) Is Nothing) Then
Target.Value = UCase(Target.Value)
End If
Cleanup:
If Err.Number <> 0 Then GoTo EndLine
EndLine:
Application.EnableEvents = True: Application.ScreenUpdating = True ' etc..
End Sub
Performs uppercase, and deletes multiples at once without any errors, or MsgBox's.
If they are selecting multiple cells then my thinking is that you would want to use SelectionChange macro instead, like this
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
If ((Target.Address = Target.EntireRow.Address Or _
Target.Address = Target.EntireColumn.Address)) Then Exit Sub
Application.EnableEvents = False
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) _
Is Nothing) Then
On Error GoTo endItAll
For Each aCell In Target.Cells
Range(aCell.Address) = UCase(Range(aCell.Address))
Next aCell
End If
endItAll:
Application.EnableEvents = True
SecondsElapsed = Round(Timer - StartTime, 2)
Debug.Print SecondsElapsed
End Sub
Or you could change it back to the worksheet_Change macro like below and it will not error if the user selects multiple cells or deletes cells without causing an error. The error handler is there - Like in A.S.H. 's solution, but I haven't yet seen it needed in my testing.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not (Application.Intersect(Target, Range("C1:C5000", "D1:D5000")) _
Is Nothing) Then
On Error GoTo endItAll
For Each aCell In Target.Cells
Range(aCell.Address) = UCase(Range(aCell.Address))
Next aCell
End If
endItAll:
Application.EnableEvents = True
End Sub
Account for multiple cells this way:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not (Application.Intersect(Target, Range("C2:C5000", "P3:P5000")) _
Is Nothing) Then
Dim rCell as Range
Application.EnableEvents = False
For each rCell in Target
rCell.Value = UCase(rCell.Value)
Next
Application.EnableEvents = True
End If
End Sub
My code works with a listobject.table and is intended to allow editing prices and calculating discounts or vice versa...
On entering the cell for editing it turns the formula therein into a value and pastes the formula in another column.
It works like a charm when the user is editing cells. But if the user tries to add rows to the listobject.table, the macro ruins the table. It adds a couple of columns and some headers are replaced.
Is it possible to make the macro somehow to disregard the operation of adding new rows or extending the range of data.table?
Here is the macro, thank you my friends for advice:
Private oListObj As ListObject
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Set oListObj = Worksheets("Quotation").ListObjects("tblProForma")
Application.EnableEvents = True
If Not Intersect(Target, oListObj.ListColumns("Price").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Formula = Target.Value
Application.EnableEvents = True
End If
If Not Intersect(Target, oListObj.ListColumns("Discount").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Formula = Round(Target.Value, 5)
Application.EnableEvents = True
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim PriceDiscountOffset As Integer: PriceDiscountOffset = ActiveSheet.Range("tblProForma[[#All],[Price]:[Discount]]").Columns.Count - 1
Set oListObj = Worksheets("Quotation").ListObjects("tblProForma")
Application.EnableEvents = True
If Not Intersect(Target, oListObj.ListColumns("Price").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Offset(0, PriceDiscountOffset).Formula = "=IF([#[Price]]<>"""", -([#[Price]]-[#[Pricelist]])/[#[Price]],"""")"
Application.EnableEvents = True
End If
If Not Intersect(Target, oListObj.ListColumns("Discount").DataBodyRange) Is Nothing Then
Application.EnableEvents = False
Application.AutoCorrect.AutoFillFormulasInLists = False
Target.Offset(0, -PriceDiscountOffset).Formula = "=[#[Pricelist]]-([#[Pricelist]]*[#[Discount]])"
Application.EnableEvents = True
End If
End Sub
I have a problem with visual basic. I want to make a macro/function that will multiply a number I enter by 3 and give a result in the same cell. I tried something like this:
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$Q$21" Then
Target.Value = Target.Value * 3
End If
End Sub
but it doesn't work - I'm getting results like "xE25" because it keeps multiplying.
I'd like it to stop after first iteration or work only when I press "enter" not with every change in the cell.
It's quite easy to put a result in different cell, but it's not my point.-----Edit:
I edited "If" line to :
If (Target.Column = 5 Or Target.Column = 11 Or Target.Column = 17 Or Target.Column = 23) And (Target.Row >= 19 And Target.Row <= 24) And Target.Value <> "" Then so it would work on all cells that I need. After that, the best solution is the way given by #Chrismas007, because it doesn't prompt an error when trying to delete data in few cells at once.
With error handling to ensure .EnableEvents goes back to True:
Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo CleanExit
If Target.Address = "$Q$21" Then
Application.EnableEvents = False
Target.Value = Target.Value * 3
End If
CleanExit:
Application.EnableEvents = True
On Error GoTo 0
End Sub
When a Worksheet_Change event macro changes a value, you need to set Application.EnableEvents to false or risk triggering another event and having the macro run on top of itself.
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$Q$21" Then
Application.EnableEvents = False
Target.Value = Target.Value * 3
Application.EnableEvents = True
End If
End Sub
While I would usually involve some error control in order that the .EnableEvents was always reset to true, the above should get you started.
You need to disable events to prevent recursion:
Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$Q$21" Then
application.enableevents = false
Target.Value = Target.Value * 3
application.enableevents = true
End If
End Sub
Just as an alternative, you can also use your own variable rather than tinkering with EnableEvents, though it will mean your code responds twice even though it doesn't actually do anything the second time round:
Dim bSkipEvents as Boolean
Sub Worksheet_Change(ByVal Target As Range)
If bSkipEvents then exit sub
If Target.Address = "$Q$21" Then
bSkipEvents = True
Target.Value = Target.Value * 3
bSkipEvents = False
End If
End Sub
This is also the sort of approach you need with userforms and most events for activex controls on worksheets.