VBA Array Error 2007 if statement - vba

Probably its a simple and common question but I did not find anything in google.
I store some data in array but sometimes this data has error value, in this case xlErrDiv0 2007 #DIV/0!
I use this array in a loop so i need to check if I loop through this incorrect value.
I tried:
If vRangeShift(1, i) <> CVErr(xlErrDiv0) Then
End if
If vRangeShift(1, i) = "Error 2007" Then
and some others options but I always receive type mismatch error.
vRangeShift is Variant type. The problems occurs only when I check this incorrect array element.

This should do the trick:
If IsError(vRangeShift(1, i)) Then

One approach among several would be to catch the error and handle it with some code further down.
On error goto HandleMyError
'do something with vRangeShift(1, i)
'... more code here ....'
Cont:
'finish out sub
Exit Sub 'Have this here so if there isn't an error, you can skip over
'the error handler
HandleMyError:
'if doing something with vRangeShift(1,i) produces an error, you
'you will end up here where you can handle the error as you see fit
'once you've satisfactorily handled the error, you can return to
'that part of your code where you want the sub to continue
Goto Cont
End Sub

Related

How to resume error handling from the calling function while in a subfunction in VBA?

When I write in VBA for Word or Excel, I typically have an error handler in my main function and call several subs from it, and most of the time, I want subs' messages to get caught in the main function. Typically everything works great with this strategy, and it mimics what I'm used to in C++.
However, I run into trouble when I need a different type of error handling in one or two subs.
For example, when I need to turn on Resume Next for the sake of checking if an object fails and is set to nothing. When I want to turn error handling on, my MainErrorHandler is now out of scope.
Sub Main()
On Error GoTo MainErrorHandler
Application.ScreenUpdating = False
Call OpenFile
Call SubWithOwnErrorHandling
'Do more stuff
GoTo CleanExit
MainErrorHandler:
MsgBox Err.Description
CleanExit:
Application.ScreenUpdating = True
End Sub
Sub OpenFile()
On Error Resume Next
Set objFile = objFSO.OpenTextFile(fileLocation & fileName, 1)
On Error GoTo ErrorHandler ' Label Not Defined!
If objFile Is Nothing Then
Call Err.Raise(2009, , "Out File doesn’t exist.")
End If
End Sub
Likewise, when I want to have a sub handle errors locally and occasionally elevate an error, I'm not sure how exactly to do that.
Sub SubWithOwnErrorHandling()
On Error GoTo SubErrorHandler
isReallyBad = True
If isReallyBad Then
Call Err.Raise(2020, , "Error that needs to cause application to exit!")
Else
Call Err.Raise(2001, , "Error that just needs the function to exit!")
End If
SubErrorHandler:
On Error GoTo MainErrorHandler ' Label Not Defined!
If Err.Number = 2020 Then
Call Err.Raise(2020, , Err.Description)
End If
End Sub
Is there any way to do what I'm trying to accomplish for either case?
Labels are always local.
On Error is always local too - heck, its deprecated ancestor was On Local Error!
So you can't GoTo-jump between procedure scopes (THANK GOD!!)
This means at any given time, there's only ever one of two things the run-time can do On Error:
Jump to a local error handler
Blow up the current stack frame and see if the caller handles it
[ignore the error and happily keep running blindfolded under blue skies and sunshine]
That third point, you guessed it, is what On Error Resume Next does.
One critical error you've done, is specifying an On Error statement inside an error-handling subroutine, and the error-handling subroutine runs regardless of whether you're in an error state or not. That makes following execution extremely confusing, even if that label was legal. Exit Sub or Exit Function (or heck, Exit Property, depending on what's your scope) before the handler, and make sure error-handling code is only ever hit in an error state.
Resetting error handling
So, one thing you want to do, is to reset error handling - here:
On Error Resume Next
Set objFile = objFSO.OpenTextFile(fileLocation & fileName, 1)
On Error GoTo ErrorHandler ' Label Not Defined!
You know objFSO.OpenTextFile can possibly blow up, and you want to handle it yourself, i.e. deal with the objFile Is Nothing possibiilty manually. You can absolutely do that, but then what you need is this:
On Error Resume Next
Set objFile = objFSO.OpenTextFile(fileLocation & fileName, 1)
On Error GoTo 0
On Error GoTo 0 resets error handling, i.e. the next instruction to throw an error will bubble up the call stack, until everything goes up in flames.
Custom Errors
The next thing you want to do, is to raise custom errors.
If isReallyBad Then
Call Err.Raise(2020, , "Error that needs to cause application to exit!")
Else
Call Err.Raise(2001, , "Error that just needs the function to exit!")
End If
That's pretty easy actually - but it's easier with an Enum:
Public Enum AppCustomError
ERR_ReallyBad = vbObjectError + 42
ERR_ReallyReallyBad
ERR_VeryReallyTerriblyBad
ERR_YouGetTheIdea
End Enum
The vbObjectError constant ensures that your custom error numbering doesn't step on toes; your error numbers will all be negative - and with an Enum for each possible error you can throw, you don't need to care what the actual error number is, so you let the enum member mechanics do their thing (e.g. ERR_ReallyReallyBad will be ERR_ReallyBad + 1, automatically).
Then you can do this (assuming you're in a class module - otherwise replace TypeName(Me) with some string literal, or skip it):
On Error GoTo ErrHandler
If isReallyBad Then
Err.Raise ERR_VeryReallyTerriblyBad, TypeName(Me), "Blow up the app!"
Else
Err.Raise ERR_ReallyBad, TypeName(Me), "Blow up this function!"
End If
Exit Sub
ErrHandler:
With Err
Select Case .Number
Case ERR_VeryReallyTerriblyBad
.Raise .Number 'rethrow
Case ERR_ReallyBad
'function blew up, we're done here.
'...
End Select
End With
And then the calling code, which has its own error-handling subroutine, can decide that it can't deal with ERR_VeryReallyTerriblyBad, and just blow everything up by rethrowing:
Exit Sub
MainErrorHandler:
With Err
Select Case .Number
Case ERR_VeryReallyTerriblyBad
.Raise .Number 'rethrow
Case Else
MsgBox .Description
End Select
End With

VBA MsgBox causes an erro

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.

VBA: Two methods of seeing if a file is open

I've got two methods which I feel should tell if a file is open or not.
Method 1 (Error: Subscript out of range):
If Not Workbooks(filename) Is Nothing Then
Workbooks.Open (filename)
End If
Method 2:
If Not IsWorkbookOpen(filename) Then
Workbooks.Open (filename)
End If
Where IsWorkbookOpen() is:
Private Function IsWorkbookOpen(wbname) As Boolean
Dim wBook As Workbook
Set wBook = Nothing
On Error Resume Next
Set wBook = Workbooks(wbname)
If wBook Is Nothing Then
IsWorkbookOpen = False
Else: IsWorkbookOpen = True
End If
End Function
Aside from On Error Resume Next, Method 1 appears to be nearly the same as Method 2.
Could anyone please explain why Method 1 gives the error it does?
Thank you.
They both give a subscript out of range error. But in Method 2 you suppress that error with On Error Resume Next.
Sub SeeError()
On Error Resume Next
Debug.Print Workbooks("DoesNotExist").Name
Debug.Print Err.Description
End Sub
This prints "Subscript Out of Range" in the Immediate Window. The On Error statement doesn't stop the error from occurring, it just handles it. Method 1 doesn't handle errors so the default error handling (stop execution and report the error) is in effect.
VBA tries to evaluate all the parts before it evaluates the conditional statement. So if I have a variable myvar = "xyz" and try to run the following lines...
If IsNumeric(myvar) And Round(myvar, 1) = 3 Then
'you will get an error before the IF is evaluated
End If
it will not work. VBA will evaluate IsNumeric(myvar) fine, then try to evaluate Round(myvar, 1) = 3 and get an error before it checks the entire conditional. So VBA will let you know about the error before it performs the AND operator. If VBA had short circuit evaluation, it would work fine since the first part would evaluate to false.
But the following will work
If IsNumeric(myvar) Then
If Round(myvar, 1) = 3 Then
'second IF statement is not touched since first IF statement evaluates to false
End If
End If
This works because IsNumeric(myvar) evaluates to false and therefore skips the nested statement.
So the error it throws on the Workbooks(filename) will just give the error unless you tell it to resume next. So the method I use is
On Error Resume Next
Set wb = Workbooks(file)
If wb Is Nothing Then
Set wb = Application.Workbooks.Open(dir & "\" & file, ReadOnly:=True)
End If
On Error GoTo 0
Edited to give more detail and correctly capture that the second example will not be evaluated as well as provide a useful solution for the question at hand.
Workbooks(filename) tries to get the element with the identifier (or 'index') filename from the collection Workbooks. If the collection does not contain such an element, you'll get the "Subscript out of range" error. (So in a nutshell: This code will fail whenever the file is not open. You probably don't want this.)
However, the knowledge that such an access will fail if the file is not open, i.e. an error is raised, is being made use of in the second method. The code tries to get the element with the identifier filename from the Workbooks collection and to assign it to the variable wBook. If it fails, the value of the variable wBook will stay Nothing. If it succeeds, the variable wBook will contain a reference to the respective Workbook object.

Error (Run-time error 5) will not raise when "On error resume next" is active

I've provided the actual code I'm using below.
The exact condition I'm trying to handle is the strCurrentRev argument as a zero-length string. (e.g. strCurrentRev="")
If I comment out the error handling statements, trying to execute the ASC method on a zero-length string throws Run-Time Error 5 for "invalid procedure call or argument".
If I then check err.Number it's = 5.
If I try to run the exact same statement with on error resume next active, it will not raise any errors, e.g. after execution err.number is always = 0.
If on error resume next is active, and you try to execute the ASC method from the immediate window (e.g. Type asc(strcurrentrev) and hit Enter) it will throw the run-time error and set the err.number property to 5.
I've never experienced this before. Why would having on error resume next active cause the error not to raise in normal execution???
Function NextRevLetter(strCurrentRev As String) As String
'This function returns the next revision letter given an existing revision letter.
'Declare variables
Dim lngX As Long
Dim strX As String
Dim strY As String
'First, check if we are dealing with rev A-Z or AA-ZZ
If Len(strCurrentRev) <= 1 Then
'Check that we can work with revision letter ***THIS IS WHERE I AM HAVING A PROBLEM!***
On Error Resume Next
Err.Clear
'Procedure call to flag errors with ASC method without changing any values
lngX=Asc(strCurrentRev)
lngX=0
On Error GoTo 0
If Err.Number > 0 Then
Err.Clear
If Len(strCurrentRev) < 1 Then
'No revision specified, assign first revision"
strCurrentRev = "-"
Else
MsgBox "The revision letter specified is not compliant. The next revision letter cannot be determined.", vbOKOnly, "Error: Revision does not follow rules"
'Return the existing revision (no change) and exit function
NextRevLetter = strCurrentRev
Exit Function
End If
End If
'Code continues - not important for this question...
Exit Function
You're not using the right tool for the job. Runtime errors should be handled, not shoved under the carpet (because that's what On Error Resume Next does - execution happily continues as if nothing happened).
You need to try to avoid raising that error in the first place. What's causing it?
lngX=Asc(strCurrentRev)
You already know what's happening:
The exact condition I'm trying to handle is the strCurrentRev argument as a zero-length string.
Well then, the correct way to handle this is to verify the length of strCurrentRev before you pass it to the Asc function, which you know will raise a runtime error #5 if you give it an empty string!
If strCurrentRev <> vbNullString Then
'calling Asc(strCurrentRev) here will not fail!
End If
I was asked to elaborate on a better way to handle the error, and this is the easiest place to do so. I think it's okay, because in a way it does answer the original question as well. However, let me say first that the right thing to do here is to avoid the error entirely, but for the sake of completeness, there is a way to do this cleanly with an error handler.
The idea is to check the error number, handle it by fixing the value, and then resuming the next line of code.
Function NextRevLetter(strCurrentRev As String) As String
'This function returns the next revision letter given an existing revision letter.
On Error GoTo ErrHandler
'Declare variables
Dim lngX As Long
Dim strX As String
Dim strY As String
'First, check if we are dealing with rev A-Z or AA-ZZ
If Len(strCurrentRev) <= 1 Then
'Procedure call to flag errors with ASC method without changing any values
lngX = Asc(strCurrentRev)
lngX = 0
'Code continues - not important for this question...
End If
Exit Function
ErrHandler:
If Err.Number = 5 Then
lngX = 0
If Len(strCurrentRev) < 1 Then
'No revision specified, assign first revision"
strCurrentRev = "-"
Resume Next
Else
MsgBox "The revision letter specified is not compliant. The next revision letter cannot be determined.", vbOKOnly, "Error: Revision does not follow rules"
'Return the existing revision (no change) and exit function
NextRevLetter = strCurrentRev
Exit Function
End If
Else If Err.Number = someOtherExpectedError
'handle it appropriately
Else
' !!! This is important.
' If we come across an error we don't know how to handle, we re-raise it.
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Note that the flow of your program is not interrupted by all of this error handling and we only handle the error that we're expecting. So, if an error is raised, we recover only if we know how to. Otherwise, execution is halted.
I would still prefer just to check to see if the value is = vbNullString though.
I just figured this out. The On Error GoTo 0 statement resets the Err.Number property to 0.
Sorry for wasting anyones time!!!!

Excel VBA still breaks after On Error handler

I have a very simple bit of code that loops through a column of data and adds unique values to a Collection.
It's VBA, so of course Collection lacks an Exists function (who'd ever want that?), and I'd rather avoid iterating over the entire collection for every cell in the column, I decided to go for the error-handling approach - attempt to retrieve the item from the collection, catch the error that occurs if it doesn't exist and add it:
'Trucated the code slightly, I know I should be checking the actual error code, but omitted that for brevity
Dim r As Range
Set r = MySheet.Range("B2") 'First cell in column
Dim uniqueValues As New Collection
Do While r.Value <> ""
On Error GoTo ItemExists
'If r.Value doesn't exist in the collection, throws an error
uniqueValues.Add(Item:=r.Value, Key:=r.Value)
ItemExists:
r.Offset(1)
Loop
The problem? Excel seems to be completely ignoring the On Error line, breaking the code and throws up the Continue/End/Debug dialog regardless.
I've checked the options in VBA, it's correctly set to Break on Unhandled Errors.
Any idea why this is happening?
You could use On Error Resume Next, but you're better off encapsulating the error handling in its own Sub or Function. E.g. something like:
Private Sub AddIfNotPresent(Coll As Collection, Value As Variant, Key As Variant)
On Error Resume Next
Coll.Add Item:=Value, Key:=Key
End Sub
which you could use as follows:
Do While r.Value <> ""
AddIfNotPresent uniqueValues, r.Value, r.Value
r = r.Offset(1)
Loop
The reason for your problem is described in the VBA documentation for On Error:
An "enabled" error handler is one that is turned on by an On Error statement; an "active" error handler is an enabled handler that is in the process of handling an error. If an error occurs while an error handler is active (between the occurrence of the error and a Resume, Exit Sub, Exit Function, or Exit Property statement), the current procedure's error handler can't handle the error
You have not called Resume or exited the procedure after the first error, so the error handler can't handle subsequent errors.
UPDATE
From comments:
I hate the idea of promoting the use of On Error Resume Next ...
I can sympathise with this POV, but there are some things in VBA (e.g. checking if a key is present in a Collection) that you can only do by handling an error. If you do this in a dedicated helper method (Sub/Function), it's a reasonable approach. Of course, you can use On Error Goto instead, e.g. something like the following (a variation on the above which tests to see if a collection contains a given key):
Public Function ContainsKey(Coll As Collection, Key As Variant) As Boolean
On Error GoTo ErrHandler
Dim v As Variant
v = Coll(Key)
ContainsKey = True
Exit Function
ErrHandler:
ContainsKey = False
Exit Function
End Function
use an ArrayList instead, which has an .Contains method amongst other handy things like a .Sort method
With CreateObject("System.Collections.ArrayList")
.Add "Item 1"
.Add "Item 2"
If .Contains "Item 1" Then Msgbox "Found Item 1"
If .Contains "Item 3" Then Msgbox "Found Item 3"
End With
some more examples here