VLOOKUP across 2 worksheets for comma separated values-CodePudding

I am trying to do a vlookup using vba to look up each country per continent and return a true value on each column. For example, I get a true under Europe Lookup if Belgium is listed as one of the countries. See below for the current code I have. Issues I want to fix are:

First, I want to be able to lookup each country to confirm if they are in the countries tab. That way, I know if there is a new country I need to add. What I have currently looks up to check if at least one of the countries is listed but would like to make sure all countries are listed.

Additionally, I want to make it automated such that if a new country is added to the countries list, I don't have to edit the macros.

Also, is there a way to do the lookup for separate continents one at a time? Currently, it just returns a true if the country is in the list irrespective of the continents. I know this means I'll have separate lines of codes for each continent but that's fine.

Sub Macro1()

Sheets("Sales Table").Select
Range("D2").Select
Dim LastRowColumnD As Long
LastRowColumnD = Cells(Rows.Count, 1).End(xlUp).Row
Range("D2:D" & LastRowColumnD).Formula = "=SUMPRODUCT(--ISNUMBER(SEARCH('Countries'!R2C1:R11C1,RC[-2])))>0"

Range("E2").Select
Dim LastRowColumnE As Long
LastRowColumnE = Cells(Rows.Count, 1).End(xlUp).Row
Range("E2:E" & LastRowColumnE).Formula = "=SUMPRODUCT(--ISNUMBER(SEARCH('Countries'!R2C1:R11C1,RC[-3])))>0"

End Sub

CodePudding user response：

Not sure what kind of output are you trying to get, but something like this may work for you and you'll need to adapt a little:

Sub test()
Dim i As Long, j As Long, k As Long
Dim LR As Long
Dim Mydata As Variant
Dim WKData As Worksheet
Dim rngCountries As Range
Dim MyF As WorksheetFunction

Set MyF = WorksheetFunction

Set rngCountries = ThisWorkbook.Worksheets("Countries").Range("A2:B11")

Set WKData = ThisWorkbook.Worksheets("Sales Table")

With WKData
    LR = .Range("B" & .Rows.Count).End(xlUp).Row
    Mydata = .Range("B2:B" & LR).Value
    
    For i = 1 To UBound(Mydata) Step 1
        j = UBound(Split(Mydata(i, 1), ", "))
        'j = how many countries -1, so j 1= total countries in cell
        For k = 0 To j Step 1
            'we loop trough each country in cell
            If MyF.CountIfs(rngCountries.Columns(1), Split(Mydata(i, 1), ", ")(k), rngCountries.Columns(2), "Europe") <> 0 Then .Range("E" & (i   1)).Value = .Range("E" & (i   1)).Value   1 'Europe Check
            If MyF.CountIfs(rngCountries.Columns(1), Split(Mydata(i, 1), ", ")(k), rngCountries.Columns(2), "Africa") <> 0 Then .Range("F" & (i   1)).Value = .Range("F" & (i   1)).Value   1 'Africa Check
            If MyF.CountIfs(rngCountries.Columns(1), Split(Mydata(i, 1), ", ")(k), rngCountries.Columns(2), "Asia") <> 0 Then .Range("G" & (i   1)).Value = .Range("G" & (i   1)).Value   1 'Asia Check
        Next k
        
        'check all countries: if the sum equals k 1, then all countries in cell are present
        .Range("D" & (i   1)).Value = IIf(MyF.Sum(Range("E" & (i   1) & ":G" & (i   1))) = k, "YES", "NO")
    Next i
End With

'clean variables
Erase Mydata
Set MyF = Nothing
Set rngCountries = Nothing
Set WKData = Nothing

End Sub

I've used arrays and Splits to create arrays so you can loop trough each individual country:

Notice I added "Portugal" to check the "NO" value in the "All countries" column. Every NO means there is a country in that cell that is not present in your range of countries.

CodePudding user response：

If you can reformat your input that might make your life easier. Otherwise, splitting in vba is also what I would do.

Sub macroSplitter()
Dim wb As Workbook
Dim salesSheet As Worksheet, Countries As Worksheet, contenent As String
Dim j As Long
Set wb = ThisWorkbook
Set salesSheet = wb.Worksheets("Sales Table")
Set Countries = wb.Worksheets("Countries")

countryArray = Countries.Range("A2").CurrentRegion.Value2

For Each cell In salesSheet.Range("B2", salesSheet.Range("B2").End(xlDown))
    splitCell = Split(cell, ", ")
    For Each country In splitCell
        If inCountry(country, countryArray) Then
            contenent = whichContenent(country, countryArray)
            Cells(cell.Row, WorksheetFunction.Match(contenent, salesSheet.Range("A1", salesSheet.Range("A1").End(xlToRight)), 0)).Value2 = True
        Else
            cell.Offset(0, 2).Value2 = False
        End If
    Next
    If cell.Offset(0, 2).Value2 = vbNullString Then cell.Offset(0, 2).Value2 = True
    For j = WorksheetFunction.Match("Europe", salesSheet.Range("A1", salesSheet.Range("A1").End(xlToRight)), 0) To salesSheet.Range("A1").End(xlToRight).Column
        If Cells(cell.Row, j).Value2 = vbNullString Then Cells(cell.Row, j).Value2 = False
    Next
Next cell

End Sub

Private Function inCountry(c, arr) As Boolean
Dim i As Long
    For i = 2 To UBound(arr, 1)
        If c = arr(i, 1) Then inCountry = True
    Next
End Function

Private Function whichContenent(c, arr) As String
Dim i As Long
    For i = 2 To UBound(arr, 1)
        If c = arr(i, 1) Then whichContenent = arr(i, 2)
    Next
End Function