Check If Item Exists in Collection with Application.Match in VBA - vba

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