Determining whether an object is a member of a collection in VBA - vba

How do I determine whether an object is a member of a collection in VBA?
Specifically, I need to find out whether a table definition is a member of the TableDefs collection.

Isn't it good enough?
Public Function Contains(col As Collection, key As Variant) As Boolean
Dim obj As Variant
On Error GoTo err
Contains = True
obj = col(key)
Exit Function
err:
Contains = False
End Function

Not exactly elegant, but the best (and quickest) solution i could find was using OnError. This will be significantly faster than iteration for any medium to large collection.
Public Function InCollection(col As Collection, key As String) As Boolean
Dim var As Variant
Dim errNumber As Long
InCollection = False
Set var = Nothing
Err.Clear
On Error Resume Next
var = col.Item(key)
errNumber = CLng(Err.Number)
On Error GoTo 0
'5 is not in, 0 and 438 represent incollection
If errNumber = 5 Then ' it is 5 if not in collection
InCollection = False
Else
InCollection = True
End If
End Function

Your best bet is to iterate over the members of the collection and see if any match what you are looking for. Trust me I have had to do this many times.
The second solution (which is much worse) is to catch the "Item not in collection" error and then set a flag to say the item does not exist.

This is an old question. I have carefully reviewed all the answers and comments, tested the solutions for performance.
I came up with the fastest option for my environment which does not fail when a collection has objects as well as primitives.
Public Function ExistsInCollection(col As Collection, key As Variant) As Boolean
On Error GoTo err
ExistsInCollection = True
IsObject(col.item(key))
Exit Function
err:
ExistsInCollection = False
End Function
In addition, this solution does not depend on hard-coded error values. So the parameter col As Collection can be substituted by some other collection type variable, and the function must still work. E.g., on my current project, I will have it as col As ListColumns.

You can shorten the suggested code for this as well as generalize for unexpected errors.
Here you go:
Public Function InCollection(col As Collection, key As String) As Boolean
On Error GoTo incol
col.Item key
incol:
InCollection = (Err.Number = 0)
End Function

In your specific case (TableDefs) iterating over the collection and checking the Name is a good approach. This is OK because the key for the collection (Name) is a property of the class in the collection.
But in the general case of VBA collections, the key will not necessarily be part of the object in the collection (e.g. you could be using a Collection as a dictionary, with a key that has nothing to do with the object in the collection). In this case, you have no choice but to try accessing the item and catching the error.

I created this solution from the above suggestions mixed with microsofts solution of for iterating through a collection.
Public Function InCollection(col As Collection, Optional vItem, Optional vKey) As Boolean
On Error Resume Next
Dim vColItem As Variant
InCollection = False
If Not IsMissing(vKey) Then
col.item vKey
'5 if not in collection, it is 91 if no collection exists
If Err.Number <> 5 And Err.Number <> 91 Then
InCollection = True
End If
ElseIf Not IsMissing(vItem) Then
For Each vColItem In col
If vColItem = vItem Then
InCollection = True
GoTo Exit_Proc
End If
Next vColItem
End If
Exit_Proc:
Exit Function
Err_Handle:
Resume Exit_Proc
End Function

I have some edit, best working for collections:
Public Function Contains(col As collection, key As Variant) As Boolean
Dim obj As Object
On Error GoTo err
Contains = True
Set obj = col.Item(key)
Exit Function
err:
Contains = False
End Function

For the case when key is unused for collection:
Public Function Contains(col As Collection, thisItem As Variant) As Boolean
Dim item As Variant
Contains = False
For Each item In col
If item = thisItem Then
Contains = True
Exit Function
End If
Next
End Function

this version works for primitive types and for classes (short test-method included)
' TODO: change this to the name of your module
Private Const sMODULE As String = "MVbaUtils"
Public Function ExistsInCollection(oCollection As Collection, sKey As String) As Boolean
Const scSOURCE As String = "ExistsInCollection"
Dim lErrNumber As Long
Dim sErrDescription As String
lErrNumber = 0
sErrDescription = "unknown error occurred"
Err.Clear
On Error Resume Next
' note: just access the item - no need to assign it to a dummy value
' and this would not be so easy, because we would need different
' code depending on the type of object
' e.g.
' Dim vItem as Variant
' If VarType(oCollection.Item(sKey)) = vbObject Then
' Set vItem = oCollection.Item(sKey)
' Else
' vItem = oCollection.Item(sKey)
' End If
oCollection.Item sKey
lErrNumber = CLng(Err.Number)
sErrDescription = Err.Description
On Error GoTo 0
If lErrNumber = 5 Then ' 5 = not in collection
ExistsInCollection = False
ElseIf (lErrNumber = 0) Then
ExistsInCollection = True
Else
' Re-raise error
Err.Raise lErrNumber, mscMODULE & ":" & scSOURCE, sErrDescription
End If
End Function
Private Sub Test_ExistsInCollection()
Dim asTest As New Collection
Debug.Assert Not ExistsInCollection(asTest, "")
Debug.Assert Not ExistsInCollection(asTest, "xx")
asTest.Add "item1", "key1"
asTest.Add "item2", "key2"
asTest.Add New Collection, "key3"
asTest.Add Nothing, "key4"
Debug.Assert ExistsInCollection(asTest, "key1")
Debug.Assert ExistsInCollection(asTest, "key2")
Debug.Assert ExistsInCollection(asTest, "key3")
Debug.Assert ExistsInCollection(asTest, "key4")
Debug.Assert Not ExistsInCollection(asTest, "abcx")
Debug.Print "ExistsInCollection is okay"
End Sub

It requires some additional adjustments in case the items in the collection are not Objects, but Arrays. Other than that it worked fine for me.
Public Function CheckExists(vntIndexKey As Variant) As Boolean
On Error Resume Next
Dim cObj As Object
' just get the object
Set cObj = mCol(vntIndexKey)
' here's the key! Trap the Error Code
' when the error code is 5 then the Object is Not Exists
CheckExists = (Err <> 5)
' just to clear the error
If Err <> 0 Then Call Err.Clear
Set cObj = Nothing
End Function
Source: http://coderstalk.blogspot.com/2007/09/visual-basic-programming-how-to-check.html

It works for me
Public Function contains(col As Collection, key As Variant) As Boolean
For Each element In col
If (element = key) Then
contains = True
Exit Function
End If
Next
contains = False
End Function

Not my code, but I think it's pretty nicely written. It allows to check by the key as well as by the Object element itself and handles both the On Error method and iterating through all Collection elements.
https://danwagner.co/how-to-check-if-a-collection-contains-an-object/
I'll not copy the full explanation since it is available on the linked page. Solution itself copied in case the page eventually becomes unavailable in the future.
The doubt I have about the code is the overusage of GoTo in the first If block but that's easy to fix for anyone so I'm leaving the original code as it is.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT : Kollection, the collection we would like to examine
' : (Optional) Key, the Key we want to find in the collection
' : (Optional) Item, the Item we want to find in the collection
'OUTPUT : True if Key or Item is found, False if not
'SPECIAL CASE: If both Key and Item are missing, return False
Option Explicit
Public Function CollectionContains(Kollection As Collection, Optional Key As Variant, Optional Item As Variant) As Boolean
Dim strKey As String
Dim var As Variant
'First, investigate assuming a Key was provided
If Not IsMissing(Key) Then
strKey = CStr(Key)
'Handling errors is the strategy here
On Error Resume Next
CollectionContains = True
var = Kollection(strKey) '<~ this is where our (potential) error will occur
If Err.Number = 91 Then GoTo CheckForObject
If Err.Number = 5 Then GoTo NotFound
On Error GoTo 0
Exit Function
CheckForObject:
If IsObject(Kollection(strKey)) Then
CollectionContains = True
On Error GoTo 0
Exit Function
End If
NotFound:
CollectionContains = False
On Error GoTo 0
Exit Function
'If the Item was provided but the Key was not, then...
ElseIf Not IsMissing(Item) Then
CollectionContains = False '<~ assume that we will not find the item
'We have to loop through the collection and check each item against the passed-in Item
For Each var In Kollection
If var = Item Then
CollectionContains = True
Exit Function
End If
Next var
'Otherwise, no Key OR Item was provided, so we default to False
Else
CollectionContains = False
End If
End Function

i used this code to convert array to collection and back to array to remove duplicates, assembled from various posts here (sorry for not giving properly credit).
Function ArrayRemoveDups(MyArray As Variant) As Variant
Dim nFirst As Long, nLast As Long, i As Long
Dim item As Variant, outputArray() As Variant
Dim Coll As New Collection
'Get First and Last Array Positions
nFirst = LBound(MyArray)
nLast = UBound(MyArray)
ReDim arrTemp(nFirst To nLast)
i = nFirst
'convert to collection
For Each item In MyArray
skipitem = False
For Each key In Coll
If key = item Then skipitem = True
Next
If skipitem = False Then Coll.Add (item)
Next item
'convert back to array
ReDim outputArray(0 To Coll.Count - 1)
For i = 1 To Coll.Count
outputArray(i - 1) = Coll.item(i)
Next
ArrayRemoveDups = outputArray
End Function

I did it like this, a variation on Vadims code but to me a bit more readable:
' Returns TRUE if item is already contained in collection, otherwise FALSE
Public Function Contains(col As Collection, item As String) As Boolean
Dim i As Integer
For i = 1 To col.Count
If col.item(i) = item Then
Contains = True
Exit Function
End If
Next i
Contains = False
End Function

I wrote this code. I guess it can help someone...
Public Function VerifyCollection()
For i = 1 To 10 Step 1
MyKey = "A"
On Error GoTo KillError:
Dispersao.Add 1, MyKey
GoTo KeepInForLoop
KillError: 'If My collection already has the key A Then...
count = Dispersao(MyKey)
Dispersao.Remove (MyKey)
Dispersao.Add count + 1, MyKey 'Increase the amount in relationship with my Key
count = Dispersao(MyKey) 'count = new amount
On Error GoTo -1
KeepInForLoop:
Next
End Function

Related

Collection return value from key

I am having issues returning a value from a collection using the key.
The GetPercentsUpdateCharts sub is creating a new collection and placing a new value into it with key {{percentOpen}} and value "Test".
The Contains function written with Debug.Print is outputting true which proves the key exists in the collection.
The Retrieve function always returns "Not Found".
Where did I go wrong with this?
Private Sub GetPercentsUpdateCharts()
Set colPercentTokens = Nothing
Set colPercentTokens = New Collection
'Calculate Percents and Update Charts
Store colPercentTokens, "{{percentOpen}}", "Test"
Debug.Print Contains(colPercentTokens, "{{percentOpen}}")
Debug.Print Retrieve(colPercentTokens, "{{percentOpen}}")
End Sub
Public Function Contains(col As Collection, key As String) As Boolean
On Error GoTo NotFound
Dim itm As Object
Set itm = col(key)
Contains = True
MyExit:
Exit Function
NotFound:
Contains = False
Resume MyExit
End Function
Public Function Retrieve(col As Collection, key As String) As String
On Error GoTo NotFound
Dim itm As Object
Set itm = col(key)
Retrieve = CStr(itm)
MyExit:
Exit Function
NotFound:
Retrieve = "Not Found"
Resume MyExit
End Function
Public Sub Store(col As Collection, k As String, v As String)
Dim kv As Object
If (Contains(col, k)) Then
Set kv = col(k)
kv.value = v
Else
Set kv = New KeyValue
kv.Init k, v
col.Add kv, k
End If
End Sub

Check if ActiveX label contains part of string

I am using this code to hide a label based on if it contains % sign only and nothing else.
It is this part of the code it is erroring now when running. Error: "OLEFormat.Object: Invalid Request. Command cannot be applied to a shape range with multiple shapes"
What should be the correct code?
If InStr(1, myRange.OLEFormat.Object.Caption, "%", vbTextCompare) > 0 Then
Sub c_Three_RemovePercent()
For slideNumber = 1 To 11
Set mydocument = ActivePresentation.Slides(slideNumber)
mydocument.Select
Dim myArray() As Variant
Dim myRange As Object
myArray = Array("Lbl_V1", "Lbl_V2", "Lbl_V3", "Lbl_V4", "Lbl_V5")
Set myRange = ActivePresentation.Slides(1).Shapes.Range(myArray)
With mydocument.Shapes.Range(myArray)
If InStr(1, myRange.OLEFormat.Object.Caption, "%", vbTextCompare) > 0 Then
mydocument.Shapes(myRange).Visible = False
Else: mydocument.Shapes(myRange).Visible = True
End If
End With
Next slideNumber
End Sub
All these blindfolded late-bound member calls are easily confusing: you don't get IntelliSense to help you navigate the available members.
You're looking for an OLEObject, so declare one; assign it:
Dim oleLabel As Excel.OLEObject
Set oleLabel = ActivePresentation.Slides(1).Shapes("SomeShapeName").OLEFormat.Object
Now you want the control that's in that OLEObject's Object property, and you want to cast that control to its MSForms.Label interface:
Dim labelControl As MSForms.Label
Set labelControl = oleLabel.Object
Now you have an early-bound MSForms.Label interface to query, and IntelliSense guides you all the way:
If Contains(labelControl.Caption, "%") Then
'...
Else
'...
End If
Where Contains could look something like this:
Public Function Contains(ByVal source As String, ByVal substring As String) As Boolean
Contains = InStr(1, source, substring, vbTextCompare) > 0
End Function
You have an array of label control names you want to iterate - just iterate it:
Dim labelNames As Variant
labelNames = Array("label1", "label2", "label3", ...)
Dim i As Long
For i = LBound(labelNames) To UBound(labelNames)
Set oleLabel = currentSlide.Shapes(labelNames(i)).OLEObject
oleLabel.Visible = Not Contains(labelControl.Caption, "%")
Next
Note how this:
If BooleanExpression Then
Thing = True
Else
Thing = False
End If
Can be rewritten as:
Thing = BooleanExpression
For checking if string contains the vba function INSTR is typically best. Basically in the below example... Starting in the first position, check this text, look for "%", case insensative.
If InStr(1, myRange.OLEFormat.Object.Caption, "%", vbTextCompare) > 0 Then
mydocument.Shapes(myRange).Visible = False
Else: mydocument.Shapes(myRange).Visible = True
End If

How to change value of an item of a collection

With this code (in excel-vba) I add to a collection a number of items depending on an array.
I use the value of the array as key and the string "NULL" as value for each item added.
Dim Coll As New collection
Dim myArr()
Set Coll = New collection
myArr() = Array("String1", "String2", "String3")
For i = LBound(myArr) To UBound(myArr)
Coll.Add "NULL", myArr(i)
Next i
Now, if I want to change the value of an item, identifying it by the key, I must remove the item and then add an item with same key or is it possible to change the item value?
This below is the only way?
Coll.Remove "String1"
Coll.Add "myString", "String1"
Or is there something like: (I know that doesn't work)
Coll("String1") = "myString"
You can also write a (public) function to make updates to a collection.
public function updateCollectionWithStringValue(coll as Collection, key as string, value as string) as collection
coll.remove key
coll.add value, key
set updateCollectionWithStringValue = coll
end function
You can invoke this function by:
set coll = updateCollectionWithStringValue(coll, "String1","myString")
Then you have a one liner to invoke.
Can't you use the Before argument to fulfill this requirement?
Example:
Option Explicit
Sub TestProject()
Dim myStrings As New Collection
myStrings.Add item:="Text 1"
myStrings.Add item:="Text 2"
myStrings.Add item:="Text 3"
' Print out the content of collection "myStrings"
Debug.Print "--- Initial collection content ---"
PrintCollectionContent myStrings
' Or with the "Call" keyword: Call PrintCollectionContent(myStrings)
Debug.Print "--- End Initial collection content ---"
' Now we want to change "Text 2" into "New Text"
myStrings.Add item:="New Text", Before:=2 ' myStrings will now contain 4 items
Debug.Print "--- Collection content after adding the new content ---"
' Print out the 'in-between' status of collection "myStrings" where we have
' both the new string and the string to be replaced still in.
PrintCollectionContent myStrings
Debug.Print "--- End Collection content after adding the new content ---"
myStrings.Remove 3
' Print out the final status of collection "myStrings" where the obsolete
' item is removed
Debug.Print "--- Collection content after removal of the old content ---"
PrintCollectionContent myStrings
Debug.Print "--- End Collection content after removal of the old content ---"
End Sub
Private Sub PrintCollectionContent(ByVal myColl As Variant)
Dim i as Integer
For i = 1 To myColl.Count()
Debug.Print myColl.Item(i)
Next i
End Sub
Shouldn't this do the job?
Here is a solution where Coll("String1") = "myString" does work.
When you .Add an object to a VBA collection, the object itself is added, not its value. This means you can change the object's properties while it is in the collection. I've created a class module which wraps a single variant in a class object, with .Value as its default property. Save this to a .cls file, then File > Import File in the VBA editor.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsValue"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Compare Database
Option Explicit
Private MyValue As Variant
Property Get Value() As Variant
Attribute Value.VB_UserMemId = 0
Value = MyValue
End Property
Property Let Value(v As Variant)
Attribute Value.VB_UserMemId = 0
MyValue = v
End Property
Now this version of your code works the way you had hoped:
Private Sub clsValue_test()
Dim Coll As New Collection
Dim myArr()
Dim v As Variant
myArr = Array("String1", "String2", "String3")
For Each v In myArr
Coll.Add New clsValue, v
Coll(v) = "NULL"
Next v
Coll("String1") = "myString" ' it works!
For Each v In myArr
Debug.Print v, ": "; Coll(v)
Next v
End Sub
Produces the result:
String1 : myString
String2 : NULL
String3 : NULL
A variant of making a function that deletes the collection item by its key, is implementing it as a VBA Property
Public Property Let CollectionValue(coll As Collection, key As String, value As String)
On Error Resume Next
coll.Remove key
On Error GoTo 0
coll.Add value, key
End Property
Public Property Get CollectionValue(coll As Collection, key As String) As String
CollectionValue = coll(key)
End Property
And Used like this
'Writing
CollectionValue(coll, "Date") = Now()
'Reading
Debug.Print(CollectionValue(coll, "Date"))
By ignoring if key not exists, it can be used to add items as well
just loop the collection and add the new values to a new collection...
function prep_new_collection(my_old_data as collection) as collection
dim col_data_prep as new collection
for i = 1 to my_old_data.count
if my_old_data(i)(0)= "whatever" then
col_data_prep.add array("NULL", my_old_data(i)(1))
else
col_data_prep.add array(my_old_data(i)(0), my_old_data(i)(1))
end if
next i
set prep_new_collection = col_data_prep
end function
I just ran into the same issue an thought to post my solution here for any one who might need it. my solution was to make a class called
EnhancedCollection that has an update function. save this code to a file named EnhancedCollection.cls and then import into your project.
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "EnhancedCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private data As New Collection
'=================================ADD
If IsMissing(key) Then
If IsMissing(before) Then
If IsMissing(after) Then
data.Add Value
Else
data.Add Value, , , after
End If
Else
data.Add Value, , before
End If
ElseIf key = "TEMP_ITEM" Then
Exit Sub
Else
If IsMissing(before) Then
If IsMissing(after) Then
data.Add Value, key
Else
data.Add Value, key, , after
End If
Else
data.Add Value, key, before
End If
End If
End Sub
'=================================REMOVE
Sub Remove(key As Variant)
data.Remove key
End Sub
'=================================COUNT
Function Count() As Integer
Count = data.Count
End Function
'=================================ITEM
Function Item(key As Variant) As Variant
'This is the default Function of the class
Attribute Item.VB_Description = "returns the item"
Attribute Item.VB_UserMemId = 0
On Error GoTo OnError
If VarType(key) = vbString Or VarType(key) = vbInteger Then
Item = data.Item(key)
End If
Exit Function
OnError:
Item = Null
End Function
'=================================Update
Function Update(key As Variant, Value As Variant) As Variant
On Error GoTo OnError
If VarType(key) = vbString Or VarType(key) = vbInteger Then
data.Add "", "TEMP_ITEM", , key
data.Remove key
data.Add Value, key, "TEMP_ITEM"
data.Remove "TEMP_ITEM"
End If
Exit Function
OnError:
Update = Null
End Function
And as an added benefit, you can always add more functionality.

FILTER Function for integers - VBA

I searched the website but was not succesfful and tried doing some research on this but facing with " Type Mismatch" error.
I declared an array as integer type but the FILTER function seems to work only with STRING's. Can you please let me know how I can use the FILTER function for integers?
If UBound(Filter(CntArr(), count)) > 0 Then
msgbox "found"
End If
as i understand you need to know if specified count present in array. You can use for loop for it:
Dim found as Boolean
found = False
For i = 0 To UBound (CntArr())
If CntArr(i) = count Then
found = True
Exit For
End If
Next i
If found Then msgbox "found" End If
Below I have created IsIntegerInArray() function that returns boolean. Follow the two Subs for an example of integer array declaration. Declaring array as Integer should also prevent some unnecessary bugs caused by implicit data conversion.
Sub test_int_array()
Dim a() As Integer
ReDim a(3)
a(0) = 2
a(1) = 15
a(2) = 16
a(3) = 8
''' expected result: 1 row for each integer in the array
Call test_printing_array(a)
End Sub
Sub test_printing_array(arr() As Integer)
Dim i As Integer
For i = 1 To 20
If IsIntegerInArray(i, arr) Then
Debug.Print i & " is in array."
End If
Next i
End Sub
Function IsIntegerInArray(integerToBeFound As Integer, arr() As Integer) As Boolean
Dim i As Integer
''' incorrect approach:
''' IsIntegerInArray = (UBound(Filter(arr, integerToBeFound)) > -1) ' this approach searches for string, e.g. it matches "1" in "12"
''' correct approach:
IsIntegerInArray = False
For i = LBound(arr) To UBound(arr)
If arr(i) = integerToBeFound Then
IsIntegerInArray = True
Exit Function
End If
Next i
End Function

How to check for empty array in vba macro [duplicate]

This question already has answers here:
How do I determine if an array is initialized in VB6?
(24 answers)
Closed 3 years ago.
I want to check for empty arrays. Google gave me varied solutions but nothing worked. Maybe I am not applying them correctly.
Function GetBoiler(ByVal sFile As String) As String
'Email Signature
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function
Dim FileNamesList As Variant, i As Integer
' activate the desired startfolder for the filesearch
FileNamesList = CreateFileList("*.*", False) ' Returns File names
' performs the filesearch, includes any subfolders
' present the result
' If there are Signatures then populate SigString
Range("A:A").ClearContents
For i = 1 To UBound(FileNamesList)
Cells(i + 1, 1).Formula = FileNamesList(i)
Next i
SigString = FileNamesList(3)
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
Here if FileNamesList array is empty, GetBoiler(SigString) should not get called at all. When FileNamesList array is empty, SigString is also empty and this calls GetBoiler() function with empty string. I get an error at line
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
since sFile is empty. Any way to avoid that?
Go with a triple negative:
If (Not Not FileNamesList) <> 0 Then
' Array has been initialized, so you're good to go.
Else
' Array has NOT been initialized
End If
Or just:
If (Not FileNamesList) = -1 Then
' Array has NOT been initialized
Else
' Array has been initialized, so you're good to go.
End If
In VB, for whatever reason, Not myArray returns the SafeArray pointer. For uninitialized arrays, this returns -1. You can Not this to XOR it with -1, thus returning zero, if you prefer.
(Not myArray) (Not Not myArray)
Uninitialized -1 0
Initialized -someBigNumber someOtherBigNumber
Source
As you are dealing with a string array, have you considered Join?
If Len(Join(FileNamesList)) > 0 Then
If you test on an array function it'll work for all bounds:
Function IsVarArrayEmpty(anArray As Variant)
Dim i As Integer
On Error Resume Next
i = UBound(anArray,1)
If Err.number = 0 Then
IsVarArrayEmpty = False
Else
IsVarArrayEmpty = True
End If
End Function
I see similar answers on here... but not mine...
This is how I am unfortunatley going to deal with it... I like the len(join(arr)) > 0 approach, but it wouldn't work if the array was an array of emptystrings...
Public Function arrayLength(arr As Variant) As Long
On Error GoTo handler
Dim lngLower As Long
Dim lngUpper As Long
lngLower = LBound(arr)
lngUpper = UBound(arr)
arrayLength = (lngUpper - lngLower) + 1
Exit Function
handler:
arrayLength = 0 'error occured. must be zero length
End Function
When writing VBA there is this sentence in my head: "Could be so easy, but..."
Here is what I adopted it to:
Private Function IsArrayEmpty(arr As Variant)
' This function returns true if array is empty
Dim l As Long
On Error Resume Next
l = Len(Join(arr))
If l = 0 Then
IsArrayEmpty = True
Else
IsArrayEmpty = False
End If
If Err.Number > 0 Then
IsArrayEmpty = True
End If
On Error GoTo 0
End Function
Private Sub IsArrayEmptyTest()
Dim a As Variant
a = Array()
Debug.Print "Array is Empty is " & IsArrayEmpty(a)
If IsArrayEmpty(a) = False Then
Debug.Print " " & Join(a)
End If
End Sub
This code doesn't do what you expect:
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
If you pass an empty string ("") or vbNullString to Dir, it will return the name of the first file in the current directory path (the path returned by CurDir$). So, if SigString is empty, your If condition will evaluate to True because Dir will return a non-empty string (the name of the first file in the current directory), and GetBoiler will be called. And if SigString is empty, the call to fso.GetFile will fail.
You should either change your condition to check that SigString isn't empty, or use the FileSystemObject.FileExists method instead of Dir for checking if the file exists. Dir is tricky to use precisely because it does things you might not expect it to do. Personally, I would use Scripting.FileSystemObject over Dir because there's no funny business (FileExists returns True if the file exists, and, well, False if it doesn't). What's more, FileExists expresses the intent of your code much clearly than Dir.
Method 1: Check that SigString is non-empty first
If SigString <> "" And Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
Method 2: Use the FileSystemObject.FileExists method
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(SigString) Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
I am simply pasting below the code by the great Chip Pearson. It works a charm.
Here's his page on array functions.
I hope this helps.
Public Function IsArrayEmpty(Arr As Variant) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IsArrayEmpty
' This function tests whether the array is empty (unallocated). Returns TRUE or FALSE.
'
' The VBA IsArray function indicates whether a variable is an array, but it does not
' distinguish between allocated and unallocated arrays. It will return TRUE for both
' allocated and unallocated arrays. This function tests whether the array has actually
' been allocated.
'
' This function is really the reverse of IsArrayAllocated.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim LB As Long
Dim UB As Long
err.Clear
On Error Resume Next
If IsArray(Arr) = False Then
' we weren't passed an array, return True
IsArrayEmpty = True
End If
' Attempt to get the UBound of the array. If the array is
' unallocated, an error will occur.
UB = UBound(Arr, 1)
If (err.Number <> 0) Then
IsArrayEmpty = True
Else
''''''''''''''''''''''''''''''''''''''''''
' On rare occasion, under circumstances I
' cannot reliably replicate, Err.Number
' will be 0 for an unallocated, empty array.
' On these occasions, LBound is 0 and
' UBound is -1.
' To accommodate the weird behavior, test to
' see if LB > UB. If so, the array is not
' allocated.
''''''''''''''''''''''''''''''''''''''''''
err.Clear
LB = LBound(Arr)
If LB > UB Then
IsArrayEmpty = True
Else
IsArrayEmpty = False
End If
End If
End Function
Simplified check for Empty Array:
Dim exampleArray() As Variant 'Any Type
If ((Not Not exampleArray) = 0) Then
'Array is Empty
Else
'Array is Not Empty
End If
Here is another way to do it. I have used it in some cases and it's working.
Function IsArrayEmpty(arr As Variant) As Boolean
Dim index As Integer
index = -1
On Error Resume Next
index = UBound(arr)
On Error GoTo 0
If (index = -1) Then IsArrayEmpty = True Else IsArrayEmpty = False
End Function
Based on ahuth's answer;
Function AryLen(ary() As Variant, Optional idx_dim As Long = 1) As Long
If (Not ary) = -1 Then
AryLen = 0
Else
AryLen = UBound(ary, idx_dim) - LBound(ary, idx_dim) + 1
End If
End Function
Check for an empty array; is_empty = AryLen(some_array)=0
Public Function IsEmptyArray(InputArray As Variant) As Boolean
On Error GoTo ErrHandler:
IsEmptyArray = Not (UBound(InputArray) >= 0)
Exit Function
ErrHandler:
IsEmptyArray = True
End Function
You can use the below function to check if variant or string array is empty in vba
Function IsArrayAllocated(Arr As Variant) As Boolean
On Error Resume Next
IsArrayAllocated = IsArray(Arr) And _
Not IsError(LBound(Arr, 1)) And _
LBound(Arr, 1) <= UBound(Arr, 1)
End Function
Sample usage
Public Function test()
Dim Arr(1) As String
Arr(0) = "d"
Dim x As Boolean
x = IsArrayAllocated(Arr)
End Function
Another method would be to do it sooner. You can create a Boolean variable and set it to true once you load data to the array. so all you really need is a simple if statement of when you load data into the array.
To check whether a Byte array is empty, the simplest way is to use the VBA function StrPtr().
If the Byte array is empty, StrPtr() returns 0; otherwise, it returns a non-zero value (however, it's not the address to the first element).
Dim ar() As Byte
Debug.Assert StrPtr(ar) = 0
ReDim ar(0 to 3) As Byte
Debug.Assert StrPtr(ar) <> 0
However, it only works with Byte array.
Function IsVarArrayEmpty(anArray As Variant) as boolean
On Error Resume Next
IsVarArrayEmpty = true
IsVarArrayEmpty = UBound(anArray) < LBound(anArray)
End Function
Maybe ubound crashes and it remains at true, and if ubound < lbound, it's empty
I'll generalize the problem and the Question as intended.
Test assingment on the array, and catch the eventual error
Function IsVarArrayEmpty(anArray as Variant)
Dim aVar as Variant
IsVarArrayEmpty=False
On error resume next
aVar=anArray(1)
If Err.number then '...still, it might not start at this index
aVar=anArray(0)
If Err.number then IsVarArrayEmpty=True ' neither 0 or 1 yields good assignment
EndIF
End Function
Sure it misses arrays with all negative indexes or all > 1... is that likely? in weirdland, yes.
Personally, I think one of the answers above can be modified to check if the array has contents:
if UBound(ar) > LBound(ar) Then
This handles negative number references and takes less time than some of the other options.
You can check if the array is empty by retrieving total elements count using JScript's VBArray() object (works with arrays of variant type, single or multidimensional):
Sub Test()
Dim a() As Variant
Dim b As Variant
Dim c As Long
' Uninitialized array of variant
' MsgBox UBound(a) ' gives 'Subscript out of range' error
MsgBox GetElementsCount(a) ' 0
' Variant containing an empty array
b = Array()
MsgBox GetElementsCount(b) ' 0
' Any other types, eg Long or not Variant type arrays
MsgBox GetElementsCount(c) ' -1
End Sub
Function GetElementsCount(aSample) As Long
Static oHtmlfile As Object ' instantiate once
If oHtmlfile Is Nothing Then
Set oHtmlfile = CreateObject("htmlfile")
oHtmlfile.parentWindow.execScript ("function arrlength(arr) {try {return (new VBArray(arr)).toArray().length} catch(e) {return -1}}"), "jscript"
End If
GetElementsCount = oHtmlfile.parentWindow.arrlength(aSample)
End Function
For me it takes about 0.3 mksec for each element + 15 msec initialization, so the array of 10M elements takes about 3 sec. The same functionality could be implemented via ScriptControl ActiveX (it is not available in 64-bit MS Office versions, so you can use workaround like this).
if Ubound(yourArray)>-1 then
debug.print "The array is not empty"
else
debug.print "EMPTY"
end if
You can check its count.
Here cid is an array.
if (jsonObject("result")("cid").Count) = 0 them
MsgBox "Empty Array"
I hope this helps.
Have a nice day!
Another solution to test for empty array
if UBound(ar) < LBound(ar) then msgbox "Your array is empty!"
Or, if you already know that LBound is 0
if -1 = UBound(ar) then msgbox "Your array is empty!"
This may be faster than join(). (And I didn't check with negative indexes)
Here is my sample to filter 2 string arrays so they do not share same strings.
' Filtering ar2 out of strings that exists in ar1
For i = 0 To UBound(ar1)
' filter out any ar2.string that exists in ar1
ar2 = Filter(ar2 , ar1(i), False)
If UBound(ar2) < LBound(ar2) Then
MsgBox "All strings are the same.", vbExclamation, "Operation ignored":
Exit Sub
End If
Next
' At this point, we know that ar2 is not empty and it is filtered
'
Public Function arrayIsEmpty(arrayToCheck() As Variant) As Boolean
On Error GoTo Err:
Dim forCheck
forCheck = arrayToCheck(0)
arrayIsEmpty = False
Exit Function
Err:
arrayIsEmpty = True
End Function