How to check for empty array in vba macro [duplicate] - vba
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
Related
how to check if Split()result is valid?
I have a function LastItem which returns the last word from the string. It works fine for strings with value but for blanks like "" it fails. I am checking if Split returned an Array. Even for blank string the IsArray() returns true. Is there a way to Fix it. Errors are mentioned as comment in the code. Sub test() Debug.Print LastItem("a b c") Debug.Print LastItem("a") Debug.Print LastItem("") '''' ===> Error for this one End Sub Public Function LastItem(source As String) As String Dim arr arr = Split(source, Space(1)) If IsArray(arr) Then LastItem = arr(UBound(arr)) '''' ===> For LastItem("") error is [Subscript out of range] Else LastItem = source End If End Function
Check if upper bound is greater than -1 Public Function LastItem(source As String) As String Dim arr arr = Split(source, Space(1)) '/ Check if upper bound is greater than -1 If UBound(arr) > -1 Then LastItem = arr(UBound(arr)) Else LastItem = source End If End Function
Split always returns an array so an IsArray check is unnecessary. How about this? Bail early if the input is a zero-length string. Public Function LastItem(source As String) As String If source = vbNullString Then Exit Function Dim arr arr = Split(source, Space(1)) LastItem = arr(UBound(arr)) End Function
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
Check String if it has an ascii like "/" and ":" using VBA
Here's my code but i want to know how will I know if the string has special characters like '/' or ':'.Many Thanks. Much great if you can edit my function. Do Until EOF(1) Line Input #1, LineFromFile <-----LineFromFile is the string If HasCharacter(LineFromFile) = True Then MsgBox "This File should be uploaded to FilePath2" Else Blah Blah Blah....... This is my function Function HasCharacter(strData As String) As Boolean Dim iCounter As Integer For iCounter = 1 To Len(strData) If ....(Don't know what to say) Then HasCharacter = True Exit Function End If Next iCounter End Function
Change your code to this: Function HasCharacter(strData As String) As Boolean If InStr(strData, "/") > 0 Or InStr(strData, ":") > 0 Then HasCharacter = True Else HasCharacter = False End If End Function The function InStr returns the position of the string if found, else it returns 0.
You can simply: if strData like "*[:/]*" then msgbox "This File should be uploaded to FilePath2" else ...
Use InStr(stringToCheck, characterToFind) Function HasCharacter(strData As String) As Boolean If InStr(strData, "/") + InStr(strData, ":") > 0 Then HasCharacter = True End If End Function InStr returns 0 if the character cannot be found in the string. In this case, I add the positions of both special characters together. If the sum of these positions is greater than 0, we know that it contains at least one special character. You can separate this logic if you'd like.
if you have multiple characters then can also invert the checking and its easier to edit than multiple or statements Function HasCharacter(strData As String) As Boolean Dim iCounter As Integer For iCounter = 1 To Len(strData) If Instr ("/:", Mid (strData, iCounter, 1)) > 0 Then HasCharacter = True Exit Function End If Next iCounter End Function
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
Determining whether an object is a member of a collection in 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