Excel VBA function that cross references two data sets to come up with one solution

Question

What I'm attempting to accomplish is to create a dynamic list of businesses (I utilize data validation) that, when selected, will output an effect number.

The companies in my data set are listed along with the country codes where they conduct business (Company Table pic). The second data set includes the country codes corresponding to the nation's name and its population (Country Table pic).

Citizens of a nation are only affected if at least two of the selected corporations have operations there.

Let's say that I selected Companies 4 and 6 from the drop-down list (Company Selection pic). Since both of these businesses are located in "AZ" and "BJ," I'm attempting to get the output cell to include 1,079 entries.

This should be achievable with a choice of up to 20 companies.

I wanted to use an index match to accomplish this, but I didn't know how to make it yield an array. According to my plan, I would begin to create a special array for each company choice, which would be filled with information on each company's operating country. Then, after that array has been constructed using all of the locations of the selected companies, I would evaluate that array to check if any country code occurs twice or more. If so, I could retrieve the nation codes and sumifs on the second database.

Attempt Code:

Function Impact(CompanySelection As Range, CompanyTable As Range, CountryTable As Range)
Dim CountryCodes As Object
Dim LookupCountries As Object
Dim Results As Object
Dim CImpact As Long

Dim cell As Variable

For Each cell In CompanySelection.Range

    If cell.Value = "" Then
    Exit For

    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 2)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 3)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 4)
    CountryCodes.Add Application.WorksheetFunction.Index(CompanyTable, Application.WorksheetFunction.Match(cell, CompanyTable, 0), 5)


Next

For each cell in CountryCodes 

count # of occurances of each unique country code


If code in CountryCodes occurs >=2 Then
    LookupCountries.Add Value

For Each cell In LookupCountries

    Result.Add Application.WorksheetFunction.Index(CountryTable, 
Application.WorksheetFunction.Match(cell, CountryTable, 2))

Next


For Each cell In Result
CImpact = CImpact + cell.Value
Next

Impact = CImpact
End Function

Company table

Company	Country	Country	Country
Company 1	AO	BZ	BS
Company 2	BW	AQ	AO
Company 3	BA	BI
Company 4	BR	AZ	BJ
Company 5	AI
Company 6	AZ	BJ	BS

Country Table

Country	Citizens
AO	582
AI	536
AQ	350
AZ	732
BA	408
BI	826
BJ	347
BR	767
BS	336
BW	604
BW	601

Company Selection

Company Selection
Company 4
Company 6
...
...
...
...

Output Cell

Impacted Citizens =

Answer 1

Solution using dictionary to count

Public Sub citizens()
    Dim companyLocations As Range, locations As Range
    Set locations = Range("locations") 'Table with locations by company
    Dim dicCountries As Object
    Set dicCountries = CreateObject("Scripting.Dictionary")
    
    For Each company In Range("companySelection") 'just the cells with the dropdown list
        ix = -1
        On Error Resume Next
        ix = WorksheetFunction.Match(company.Value, locations.Columns(1), 0)
        On Error GoTo 0
        
        If ix <> -1 Then
            Set companyLocations = locations.Rows(ix)
            For c = 2 To companyLocations.Columns.Count
                Key = Trim(companyLocations.Cells(1, c))
                If dicCountries.exists(Key) Then
                    dicCountries(Key) = dicCountries(Key) + 1
                Else
                    dicCountries(Key) = 1
                End If
            Next c
        End If
    Next company
    Dim citizens  As Long
    citizens = 0
    For Each Key In dicCountries.keys()
        If dicCountries(Key) > 1 Then
            citizens = WorksheetFunction.VLookup(Key, Range("countryTable"), 2, False)
        End If
    Next Key
    Range("e36").Value = citizens 'whatever cell you want the result
End Sub

``