check if array is empty (vba excel) - excel

These if ... then statements are getting the wrong results in my opinion. The first is returning the value 'false' when it should be 'true'. The fourth returns the right value. The second and third return an error.
Sub empty_array()
Dim arr1() As Variant
If IsEmpty(arr1) Then
MsgBox "hey"
End If
If IsError(UBound(arr1)) Then
MsgBox "hey"
End If
If IsError(Application.match("*", (arr1), 0)) Then
MsgBox "hey"
End If
ReDim arr1(1)
arr1(1) = "hey"
If IsEmpty(arr1) Then
MsgBox "hey"
End If
End Sub

Arr1 becomes an array of 'Variant' by the first statement of your code:
Dim arr1() As Variant
Array of size zero is not empty, as like an empty box exists in real world.
If you define a variable of 'Variant', that will be empty when it is created.
Following code will display "Empty".
Dim a as Variant
If IsEmpty(a) then
MsgBox("Empty")
Else
MsgBox("Not Empty")
End If

Adding into this: it depends on what your array is defined as. Consider:
dim a() as integer
dim b() as string
dim c() as variant
'these doesn't work
if isempty(a) then msgbox "integer arrays can be empty"
if isempty(b) then msgbox "string arrays can be empty"
'this is because isempty can only be tested on classes which have an .empty property
'this do work
if isempty(c) then msgbox "variants can be empty"
So, what can we do? In VBA, we can see if we can trigger an error and somehow handle it, for example
dim a() as integer
dim bEmpty as boolean
bempty=false
on error resume next
bempty=not isnumeric(ubound(a))
on error goto 0
But this is really clumsy... A nicer solution is to declare a boolean variable (a public or module level is best). When the array is first initialised, then set this variable.
Because it's a variable declared at the same time, if it loses it's value, then you know that you need to reinitialise your array.
However, if it is initialised, then all you're doing is checking the value of a boolean, which is low cost. It depends on whether being low cost matters, and if you're going to be needing to check it often.
option explicit
'declared at module level
dim a() as integer
dim aInitialised as boolean
sub DoSomethingWithA()
if not aInitialised then InitialiseA
'you can now proceed confident that a() is intialised
end sub
sub InitialiseA()
'insert code to do whatever is required to initialise A
'e.g.
redim a(10)
a(1)=123
'...
aInitialised=true
end sub
The last thing you can do is create a function; which in this case will need to be dependent on the clumsy on error method.
function isInitialised(byref a() as variant) as boolean
isInitialised=false
on error resume next
isinitialised=isnumeric(ubound(a))
end function

#jeminar has the best solution above.
I cleaned it up a bit though.
I recommend adding this to a FunctionsArray module
isInitialised=false is not needed because Booleans are false when created
On Error GoTo 0 wrap and indent code inside error blocks similar to with blocks for visibility. these methods should be avoided as much as possible but ... VBA ...
Function isInitialised(ByRef a() As Variant) As Boolean
On Error Resume Next
isInitialised = IsNumeric(UBound(a))
On Error GoTo 0
End Function

I would do this as
if isnumeric(ubound(a)) = False then msgbox "a is empty!"

I may be a bit late, but following simple stuff works with string arrays:
Dim files() As String
files = "..." 'assign array
If Not Not files Then
For i = LBound(files) To UBound(files)
'do stuff, array is not empty
Next
End If
That's all the code for this.

Above methods didn´t work for me. This did:
Dim arrayIsNothing As Boolean
On Error Resume Next
arrayIsNothing = IsNumeric(UBound(YOUR_ARRAY)) And False
If Err.Number <> 0 Then arrayIsNothing = True
Err.Clear
On Error GoTo 0
'Now you can test:
if arrayIsNothing then ...

this worked for me:
Private Function arrIsEmpty(arr as variant)
On Error Resume Next
arrIsEmpty = False
arrIsEmpty = IsNumeric(UBound(arr))
End Function

The problem with VBA is that there are both dynamic and static arrays...
Dynamic Array Example
Dim myDynamicArray() as Variant
Static Array Example
Dim myStaticArray(10) as Variant
Dim myOtherStaticArray(0 To 10) as Variant
Using error handling to check if the array is empty works for a Dynamic Array, but a static array is by definition not empty, there are entries in the array, even if all those entries are empty.
So for clarity's sake, I named my function "IsZeroLengthArray".
Public Function IsZeroLengthArray(ByRef subject() As Variant) As Boolean
'Tell VBA to proceed if there is an error to the next line.
On Error Resume Next
Dim UpperBound As Integer
Dim ErrorNumber As Long
Dim ErrorDescription As String
Dim ErrorSource As String
'If the array is empty this will throw an error because a zero-length
'array has no UpperBound (or LowerBound).
'This only works for dynamic arrays. If this was a static array there
'would be both an upper and lower bound.
UpperBound = UBound(subject)
'Store the Error Number and then clear the Error object
'because we want VBA to treat unintended errors normally
ErrorNumber = Err.Number
ErrorDescription = Err.Description
ErrorSource = Err.Source
Err.Clear
On Error GoTo 0
'Check the Error Object to see if we have a "subscript out of range" error.
'If we do (the number is 9) then we can assume that the array is zero-length.
If ErrorNumber = 9 Then
IsZeroLengthArray = True
'If the Error number is something else then 9 we want to raise
'that error again...
ElseIf ErrorNumber <> 0 Then
Err.Raise ErrorNumber, ErrorSource, ErrorDescription
'If the Error number is 0 then we have no error and can assume that the
'array is not of zero-length
ElseIf ErrorNumber = 0 Then
IsZeroLengthArray = False
End If
End Function
I hope that this helps others as it helped me.

I'm using this
If UBound(a) >= 0 Then
' not empty
Else
' empty... UBound(a) = -1
End If
IsEmpty(a) did not work for me... I hate VBA
Dim arr() As Variant
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' raises error
arr = Array()
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' -1
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = "test"
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' 0

The below function works for both static and dynamic arrays.
Function array_Empty(testArr As Variant) As Boolean
Dim i As Long, k As Long, flag As Long
On Error Resume Next
i = UBound(testArr)
If Err.Number = 0 Then
flag = 0
For k = LBound(testArr) To UBound(testArr)
If IsEmpty(testArr(k)) = False Then
flag = 1
array_Empty = False
Exit For
End If
Next k
If flag = 0 Then array_Empty = True
Else
array_Empty = True
End If
End Function

Tente isso:
Function inic(mtz As Variant) As Boolean
On Error Resume Next
Dim x As Boolean
x = UBound(mtz): inic = x
End Function
...
if inic(mymtz) then
debug.print "iniciada"
else
debug.print "não iniciada"
end if

Related

Subscript Out of Range on a dynamic array

For reasons unbeknownst to me, I am getting an error on a dynamic array with in a macro. It keeps saying "Subscript out of range". But - here's the kicker - if I run the same macro again after the error is displayed, then it would not complain. Here is the piece of code that I have
Both the arrays (arrTemp and arrPBIs) are declared as in a separate module along with the rest of the variables:
Public arrPBIs() As Variant
Public arrTemp() As Variant
arrTemp = Worksheets("Prioritized PBIs Only").Range("B2:B6").Value
ReDim arrPBIs(UBound(arrTemp))
For iRw = 1 To UBound(arrTemp)
If arrTemp(iRw, 1) <> "" Then
x = x + 1
arrPBIs(x) = arrTemp(iRw, 1)
End If
Next iRw
ReDim Preserve arrPBIs(x)
Where am I going wrong? Thanks in advance for your assistance.
As a more general answer to using arrays in VBA and getting arrays from Excel into VBA the following code may be helpful. You need to have the locals and immediate windows open when you run the code.
Option Explicit
Sub ArrayDemo()
Dim VBAArray As Variant
Dim ExcelArray As Variant
Dim ExcelArray2D As Variant
Dim TransposedExcelArray As Variant
' Excel is setup to have 10 to 50 step 10 in A1:A5
' and 100 to 500 step 100 in B1:B5
VBAArray = Array(1, 2, 3, 4, 5)
ExcelArray = ActiveSheet.Range("A1:A5").Value
ExcelArray2D = ActiveSheet.Range("A1:B5").Value
TransposedExcelArray = WorksheetFunction.Transpose(ActiveSheet.Range("A1:A5").Value)
On Error Resume Next
Debug.Print ExcelArray(1) ' gives an error
Debug.Print "Error was", Err.Number, Err.Description
Err.Clear
On Error Resume Next
Debug.Print TransposedExcelArray(1) ' works fine
Debug.Print "Error was", Err.Number, Err.Description
Dim myItem As Variant
For Each myItem In ExcelArray2D
Debug.Print myItem
Next
Stop ' Look in the locals window for how the arrays are setup
End Sub

Using INDEX MATCH in VBA with Variable Lookup Locations

I am having trouble using variables within the lookup criteria in Index Match. Some background: I use the following code to set a variable's value to the row # of whatever cell contains "Current" within column B:
Dim rowHeaderNum As Integer
rowHeaderNum = 0
On Error Resume Next
rowHeaderNum = Application.Match("Current", ActiveSheet.Range("B:B"), 0)
On Error GoTo 0
Then I use the below to store the column # of the cell within the row 'rowHeaderNum' that contains the value "CurrentActual" to another variable:
Dim currActColNum As Integer
currActColNum = 0
currActColNum = Application.Match("CurrentActual", Rows(rowHeaderNum & ":" & rowHeaderNum), 0)
Below is the Index Match line that I can't get to work:
Dim currActRev As Double
currActRev = Application.Index(Columns(currActColNum), Application.Match("Gross Operating Profit", Columns("N:N"), 0))
currActRev will store a dollar amount. The Match function will always use column N as the lookup array. When I run the Index Match line I get a
type mismatch
error in the debugger.
Using WorksheetFunction …
Application.Match and On Error Resume Next does not work, because Application.Match does not throw exceptions you need to use WorksheetFunction.Match instead.
According to the documentation the WorksheetFunction.Match method it returns a Double so you need to Dim RowHeaderNum As Double.
Dim RowHeaderNum As Double
'RowHeaderNum = 0 'not needed it is always 0 after dim
On Error Resume Next
RowHeaderNum = Application.WorksheetFunction.Match("Current", ActiveSheet.Range("B:B"), False)
On Error GoTo 0
Furthermore you need to check if RowHeaderNum is 0 and stop proceeding otherwise the following code will fail because row 0 does not exist.
If RowHeaderNum = 0 Then
MsgBox "'Current' not found."
Exit Sub
End If
You need to do exactly the same here
Dim CurrActColNum As Double
On Error Resume Next
CurrActColNum = Application.WorksheetFunction.Match("CurrentActual", Rows(RowHeaderNum), False)
On Error GoTo 0
If CurrActColNum = 0 Then
MsgBox "'CurrentActual' not found."
Exit Sub
End If
Finally the WorksheetFunction.Index method returns a Variant not a Double and you need error handling here too.
Dim currActRev As Variant
On Error Resume Next
currActRev = Application.WorksheetFunction.Index(Columns(CurrActColNum), Application.WorksheetFunction.Match("Gross Operating Profit", Columns("N:N"), False))
On Error GoTo 0
Debug.Print currActRev 'print result in immediate window
Using Application …
Note that you can also use the Application.Match and Application.Index (without WorksheetFunction) but then you cannot use On Error … and you have to check for errors using IsError(). Also your variables need to be declared as Variant then because Application.Match can either return a typo Double or a type Error.
Dim RowHeaderNum As Variant
RowHeaderNum = Application.Match("Current", ActiveSheet.Range("B:B"), False)
If IsError(RowHeaderNum) Then
MsgBox "'Current' not found."
Exit Sub
End If
Dim CurrActColNum As Variant
CurrActColNum = Application.Match("CurrentActual", Rows(RowHeaderNum), False)
If IsError(CurrActColNum) Then
MsgBox "'CurrentActual' not found."
Exit Sub
End If
Dim currActRev As Variant, currMatch As Variant
currMatch = Application.Match("Gross Operating Profit", Columns("N:N"), False)
If Not IsError(currMatch) Then
currActRev = Application.Index(Columns(CurrActColNum), currMatch)
End If
Debug.Print currActRev 'print result in immediate window

Excel VBA function can't set range

I've written a VBA function that takes two parameters, the first is a string and the 2nd is a range, specified in the sheet as:
=strPack(B1,G3)
In the code, this routine is declared as:
Public Function strPack(ByVal strHex As String, ByRef rngCnt As Range) As String
On Error Goto ErrHandler
If False Then
ErrHandler:
MsgBox Err.Description
Exit Function
End If
Dim intCnt As Integer
intCnt = 0
'...do something with strHex and increment intCnt whilst we go
rngCnt.Value = CStr(intCnt)
'strPack is populated by the body of the function
strPack = "Hello World"
End Function
I've tried .Value, .Value2 and .Text, all result in an error:
Application-defined or object-defined error
When I look in the debugger, both strHex and rngCnt are valid and correct. Why can't I assign to the range and how do I fix it?
The error handler is not the problem, try it out, it works perfectly well and is a standard way of picking up errors and aborting a function when an error occurs.
[Edit] I've just tried the following:
Public Sub updateCount()
Worksheets("Sheet1").Range("G3").Value = CStr(intProcessed)
End Sub
intProcessed is global to the module and is an integer, result is the same, exactly the same error.
[Edit2] I want to remove this post as I've changed the approach now to call another subroutine that returns a value which is dropped into the cell. I can't delete it! Thank you to all for your help.
See the code comments:
Public Function strPack(ByVal strHex As String, ByVal rngCnt As Range) As String
Dim lRes As Long
On Error GoTo errHandler
lRes = 1000 '==> Your business logic goes here
'/ This is the gymnastics you do to update range from an UDF
Application.Evaluate ("UpdateRange(" & rngCnt.Address & "," & lRes & ")")
strPack = "SUCCESSFULL"
errHandler:
If Err.Number <> 0 Then
strPack = "FAILED"
End If
End Function
'/ Helper to allow range update from UDF
Private Function UpdateRange(rngDest As Range, val As Variant)
rngDest.Value = val
End Function

Is it possible to pass the fields of an array to a function with variant parameter array?

I am in the following situation: I have a function, that takes a ParamArray of type variant and generates a string from the keywords given in its ParamArray in a special manner by execution mergeToString.
Function function1(ParamArray var() As Variant) As String
For i = LBound(var) To UBound(var)
function1 = mergeToString(function1, CStr(var(i))
Next i
End Function
In another subroutine, I have an array of strings obtained from the Split Function in VBA and want to use it as an input for function1
Sub displayFCTN1()
Dim arr() As String
arr() = Split("foo|bar", "|")
'and here I ran out of ideas...
Debug.Print function1(**???**)
End Sub
The two lines
function1(**???**)
function1("foo","bar")
should be equivalent the first somehow using arr().
In Matlab this is relatively easy - I know, VBA is not Matlab, still this might help as an extended description of my problem:
you could most likely do it by using the colon operator in Matlab
function1(arr(:))
since then the fields of the array arr() count as "free" parameters.
Is there something comparable to this in VBA? I tried ReDim already, that somehow didn't do the job (as far as I tried).
Thank you for your help!
You need to test, whether the first item of array is array:
Sub FFF()
MsgBox Func1("foo", "bar")
MsgBox Func1(Split("foo|bar", "|"))
End Sub
Function Func1$(ParamArray var() As Variant)
Dim s$, x%, args
args = IIf(IsArray(var(0)), var(0), var)
'//Do something
For x = 0 To UBound(args)
s = s & args(x) & "|"
Next
Func1 = Left$(s, Len(s) - 1)
End Function
A workaround as mentioned in the comments above
Sub displayFCTN1()
Dim arr() As String
arr() = Split("foo|bar", "|")
Myhelper arr
End Sub
Sub Myhelper(arr)
Select Case UBound(arr)
Case 0: Debug.Print function1(arr(0))
Case 1: Debug.Print function1(arr(0), arr(1))
Case 2: Debug.Print function1(arr(0), arr(1), arr(2))
Case 3: Debug.Print function1(arr(0), arr(1), arr(2), arr(3))
Case 4: Debug.Print function1(arr(0), arr(1), arr(2), arr(3), arr(4))
'etc up to 29.
Case Else
End Select
End Sub
This does require a change to function1 code, but should still work with orginal.
Sub Test()
Debug.Print function1("foo", "bar")
Dim arr() As String
arr = Split("foo|bar", "|")
Debug.Print function1(arr)
End Sub
Function function1(ParamArray var() As Variant) As String
Dim i As Long
If UBound(var) = 0 Then
For i = LBound(var(0)) To UBound(var(0))
'function1 = Join(var(0), "|")
function1 = mergeToString(function1, CStr(var(0)(i)))
Next i
Else
'Original code.
For i = LBound(var) To UBound(var)
'function1 = Join(var, "|")
function1 = mergeToString(function1, CStr(var(i)))
Next i
End If
End Function

Excel VBA check if named range is set

I'm trying to determine if a named range has been set via VBA. The named range is called LoadedToken and essentially is loaded when a user clicks a particular button. I use this as proof that initialisation has taken place.
I have a function to check if this has taken place:
Function ToolIsEnabled()
' We check if the R2A add-in has been loaded by detecting the named range
If ActiveWorkbook.Names("LoadedToken") Is Nothing Then
ToolIsEnabled = False
Else
ToolIsEnabled = True
End If
End Function
and I get an application error. Of course, the VBA is incorrect. However how can I actually accomplish this?!
Sub Test()
Debug.Print IsNamedRange("Bumsti")
End Sub
Function IsNamedRange(RName As String) As Boolean
Dim N As Name
IsNamedRange = False
For Each N In ActiveWorkbook.Names
If N.Name = RName Then
IsNamedRange = True
Exit For
End If
Next
End Function
Usage in OP context could be
' ...
If IsNamedRange("LoadedToken") Then
' ...
End If
' ...
or - if a program specific Bool needs to be set
' ...
Dim IsTokenLoaded as Boolean
IsTokenLoaded = IsNamedRange("LoadedToken")
' ...
Both constructs make it pretty clear in the source code what you are aiming for.
You can achieve this by using error handling:
Function ToolIsEnabled() As Boolean
Dim rng As Range
On Error Resume Next
Set rng = ActiveWorkbook.Range("LoadedToken")
On Error GoTo 0
ToolIsEnabled = Not rng is Nothing
End Function
This will check either in ThisWorkbook or a named workbook and return TRUE/FALSE.
Sub Test()
MsgBox NamedRangeExists("SomeName")
MsgBox NamedRangeExists("SomeOtherName", Workbooks("Book1.xls"))
End Sub
Public Function NamedRangeExists(sName As String, Optional Book As Workbook) As Boolean
On Error Resume Next
If Book Is Nothing Then
Set Book = ThisWorkbook
End If
NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
Edit:
A shorter version if it's only going to look in ThisWorkbook:
Public Function NamedRangeExists(sName As String) As Boolean
On Error Resume Next
NamedRangeExists = ThisWorkbook.Names(sName).Index <> (Err.Number = 0)
On Error GoTo 0
End Function
For the activeworkbook, you could also call the old XLM NAMES() function:
Function IsNameInActiveWorkbook(sName As String) As Boolean
IsNameInActiveWorkbook = Not IsError(Application.ExecuteExcel4Macro("MATCH(""" & sName & """,NAMES(),0)"))
End Function
As per Tom's answer these 2 line should do the trick:
On Error Resume Next
Set TestRange = ActiveWorkbook.Range("LoadedToken") 'if it does **not** exist this line will be ERROR

Resources