Check If Item Exists in Collection with Applicatio

Question

I have a problem with my code for a Macro I am writing for Excel.

It specifically relates to the Method Application.Match or alternatively Application.WorksheetFunction.Match

I have an array of strings where I store the names of all companies in a list

Dim CompanyID() As String
ReDim CompanyID(NumCO)


For i = 1 To NumCO
    CompanyID(i) = Worksheets("Sheet1").Cells(i, 1).Value
Next i

Then I creat a Collection to only contain all different companies

Dim DifCO As New Collection, a

On Error Resume Next
For Each a In CompanyID
    DifCO.Add a, a
Next

Later in my code I run through the companies again to relate them with certain properties, for which I need the Index of where the company is saved in the Collection DifCO. However I haven't been able to get it with Application.Match

My program does not seem to do anything in that line and to prove it I have tried to print the Index in a MsgBox but the MsgBox doesn't appear and it doesn't even sends an error message.

For i to NumCO
    MsgBox (Application.WorksheetFunction.Match(CompanyID(i), DifCO, 0))
Next i

I have tried different things as using Application.Match and moving the elements of the Collection to another string's array but the result is the same.

I know the code loops correctly since I have observed it in the step by step debugging option. But I have ran out of ideas on what could be the problem so here I am asking this community.

Answer 1

As Mat indicates in comments on the OP, it looks like you've used On Error Resume Next without On Error GoTo 0, so the handler is swallowing the error and you're not seeing it, and the MsgBox is not displayed.

When debugging, there is an option to Break on All Errors which can be useful, although it's rather a pain in the ass in very complicated applications, for something like this it would've flagged the problem for you immediately. In the VBE under Tools > Options > General:

Generally you want to avoid Resume Next except for very small and purposeful error traps. Leaving it open like that is bound to cause errors further in your code which are then difficult to troubleshoot (as you've noticed!).

For your solution, you may use an ArrayList

Dim list as Object
Set list = CreateObject("System.Collections.ArrayList")

For Each a In CompanyID
    If Not list.Contains(a) Then list.Add(a)
Next

Then, get the index by dumping the ArrayList to a variant array using the ToArray method, and then testing that with Application.Match:

Dim arr, foundAt
arr = list.ToArray()

For i = 1 To NumCO
    foundAt = Application.Match(CompanyID(i), arr, 0) 
    If Not IsError(foundAt) Then
       MsgBox foundAt
    End If
Next i

Otherwise the usual method of getting index from a collection or an array is simply brute-force iteration over the items, and it's probably best to just spin off an ad-hoc function to do these things, rather than cluttering the main procedures with extra loops:

Sub collExample()
Dim c As New Collection
c.Add "9"
c.Add "14"
c.Add "3"
c.Add "15"
c.Add "4"
c.Add "3"

Debug.Print colItmExists(c, "5")        '~~> False
Debug.Print colItmExists(c, "10")       '~~> True
Debug.Print colItmFirstIndex(c, "3")    '~~> 3
Debug.Print colItmFirstIndex(c, "17")    '~~> -1

End Sub

Function colItmExists(col As Collection, itm) As Boolean
    Dim i, ret As Boolean
    For i = 1 To col.Count
        If col(i) = itm Then
            ret = True
            Exit For
        End If
    Next
    colItmExists = ret
End Function
Function colItmFirstIndex(col As Collection, itm) As Long
    Dim ret As Long
    If Not colItmExists(col, itm) Then
        ret = -1
    Else
        For i = 1 To col.Count
            If col(i) = itm Then
                ret = i
                Exit For
            End If
        Next
    End If
    colItmFirstIndex = ret
End Function