Now i can delete but whenever i fail to highlight a cell to delete it gives me an object required . i tried removing the error message with a cancel message box but it does not perform the delete action. Would need help to correct my mistake!
Sub deletetry2()
Dim R As Range
On Error Resume Next
Set R = Application.InputBox("Select cells To be deleted", , , , , , , 8)
On Error GoTo 0
If TypeName(rng) <> "Range" Then
MsgBox "Cancelled", vbInformation
Exit Sub
Else
R.delete
End If
End Sub
Application.InputBox is more flexible than InputBox. It's last parameter is a type parameter, with type 8 corresponding to selecting a range with the mouse.
Sample code:
Sub DeleteCells()
Dim R As Range
On Error GoTo err_handler 'if user hits "Cancel"
Set R = Application.InputBox("Select cells To be deleted", , Selection.Address, , , , , 8)
R.Delete
err_handler:
'any needed error handling code here
End Sub
On edit: I modified the code to incorporate brettdj's excellent suggestion to include the selection as the default range. I also added some error trapping to catch the case that the user clicks "Cancel" on the input box. In this case the error handling is to just exit the function, though certainly more involved error handling could be appropriate for your specific case.
A final thought -- make sure that you really want to delete the cells. That is sometimes a problematic move since it causes other cells to shift around to fill the vacuum. In many cases Clear or ClearContents can delete what you want to delete without effecting other cells.
Related
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
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
In my VBA project I have the occasional MsgBox pop up to notify the user something has 'Completed' or 'Updated' after a subroutine has run.
It seems to run okay without the MsgBox, but inserting one seems to give me an error.
Not sure if it's necessary to display the entire code here as it's quite big but at the end of a subroutine I simply want ...
MsgBox ("Completed")
which is followed by the End Sub
However when I run this and then click on OK on the Msgbox, I get a runtime error which on clicking DeBug, it highlights the End Sub.
Is there any reason why having this would throw up such an error?
Am I missing something from it?
Many thanks
Some of the code here
'Add unique data to new location
For i = 1 To UnqArray1.Count
rCell(i, 1) = UnqArray1(i)
Next
'Move Split Array into a new array
Set rTable2 = rCell
rng2() = rTable2.Value
'Filter into unique items
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
Next
'Clear location
rCell.Clear
'Add new array to location
For i = 1 To UnqArray2.Count
rCell(i, 1) = UnqArray2(i)
Next
'Find the end of the category list
lastrow = Worksheets("CatMatch").Range("Q100000").End(xlUp).Row
'Sort alphabetically
Worksheets("CatMatch").Range("Q1:Q" & lastrow).Sort key1:=Range("Q1"), order1:=xlAscending, Header:=xlNo
'Copy it to CatMatch
Worksheets("CatMatch").Range("Q1:Q" & lastrow).Copy Destination:=Worksheets("CatMatch").Range("B15")
MsgBox "Completed"
End Sub
I can't reproduce your error, but you are almost certainly incorrect that it runs okay without the MsgBox. The problem is that the problem with your code is being hidden by On Error Resume Next in the fragment:
'Filter into unique items
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
Next
Two comments:
1) Why not use the RemoveDuplicates method if that is what you are trying to do?
2) Your code is using the fact that a collection throws an error if you try to add a duplicate key. This is a valid use of On Error Resume Next -- but only if you turn it off when you are done adding keys to the collection. Something like:
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
Next
On Error GoTo 0
A good habit to get into is to consider On Error Resume Next and On Error GoTo 0 as defining a block of code, perhaps even indenting the code inside the block as I did above. An even better habit is to not assume that only 1 type of error can happen. The above code is expecting that error 457 might arise (this is the error number corresponding to trying to add a duplicate key -- you need to search documentation to find it, or just run your code without the error handling and see how it crashes). Anything else indicates some other problem. To be maximally safe you can do something like:
On Error Resume Next
For Each b In rng2
UnqArray2.Add b, b
If Err.Number > 0 And Err.Number <> 457 Then
MsgBox "Unhandled error: " & Err.Number
Exit Sub
End If
Next
On Error GoTo 0
Doing this won't solve your problem, but should make your actual problem more apparent.
Im trying to start a macro when someone double-clicks a certain range of cells. The compleet sub I got now is:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
If Not Application.Intersect(Target, Range("F5")) Is Nothing Then
cancel = True
Dim GoogleMapsCheckLink As String
GoogleMapsCheckLink = "https://www.google.nl/maps/place/" + Range("F5").Value + " " + Range("F6").Value + " " + Range("F7").Value
ActiveWorkbook.FollowHyperlink GoogleMapsCheckLink
GoogleMapsCheckYN.Show
End If
If Not Application.Intersect(Target, Range("B52, B61, D52, D61")) Is Nothing Then
cancel = True
macro
End If
End Sub
But whenever I select one of the cells e.g. B52, B61, D52 or D61 I get a compile error with the message:
Compile error:
Wrong number of arguments or invalid property assignment
The word Range is highlighted.
My question is of course what am I doing wrong currently?
EDIT:
After changing Range to
Range("B52, B61, D52, D61")
I get another error:
Run-time error '1004':
Method ' Range' of object'_Worksheet' failed
Btw I also got other macros that are being activated through double clicking a certain cell value and those do work. The error only occurs when I got multiple cells as range...
Worked for me, using Office 2010.
If the Targets are in Sheet1 then make sure the script is in the Sheet1 Module
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("B52, B61, D52, D61")) Is Nothing Then
Cancel = True
Worked = "Yes"
'Calling Macro would go here
Call SomeModule.SomeMarco
Else
Worked = "No"
End If
MsgBox Worked
End Sub
Change your range like this:
Range("B52, B61, D52, D61")
This is now a valid range reference in Excel. The Range method either accepts two references, and then refers to all the cells in between, or accepts a valid range name.
I have the following issue:
I have a macro script for excel which is running through more then 300 excel workbooks,with several sheets.
The problem is that some of this sheets have faulty hyperlinks and each time I run the macro,the pop-up message informing me that the hyperlink found in the sheet is not working and I have to click each time , : ,,cancel'' . Is there a way (code) that I can write that will automatically ,,cancel'' the pop up question ,if it appears?
You should be able to bypass this by wrapping your code in:
Application.DisplayAlerts = False
-- your code --
Application.DisplayAlerts = True
Maybe the privacy options are related?
http://office.microsoft.com/en-001/excel-help/enable-or-disable-security-alerts-about-links-to-and-files-from-suspicious-web-sites-HA010039898.aspx
Let's say your hyperlinks were pointing to a worksheet's cells, and that worksheet may no longer exist, the best thing to do may be to simply remove those hyperlinks.
This is how you'd do this :
Sub RemoveDeadHyperlinks()
For Each hyperL In ActiveSheet.Hyperlinks
'Extract name of the sheet from the subaddress
toSheet = Left(hyperL.SubAddress, InStr(hyperL.SubAddress, "!") - 1)
If WorksheetExists(toSheet) Then
'Most likely a valid hyperlink!
Else
'Most likely a dead one!
hyperL.Delete
End If
Next
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function