Check whether array is a subset of another array

[fxrexcel]

I have the following problem. I have a Column "Data" and a column "Criteria" and I want to replace the cells of "Data" with "#N/A" based on:

• if cell of "Data" is a equal to one of the criteria, then replace
• if cell of "Data" is a subset of the criteria, then replace
• if cell of "Data" is not a complete subset of the criteria, e.g. "AAA, CCC" (i.e. CCC is not in "Criteria"), then do not replace

[TABLE="width: 100"]
<tbody>[TR]
[TD]Criteria[/TD]
[/TR]
[TR]
[TD]AAA[/TD]
[/TR]
[TR]
[TD]BBB[/TD]
[/TR]
[TR]
[TD]DDD[/TD]
[/TR]
[TR]
[TD]...[/TD]
[/TR]
[TR]
[TD]...[/TD]
[/TR]
</tbody>[/TABLE]


Before:

[TABLE="width: 100"]
<tbody>[TR]
[TD]Data[/TD]
[/TR]
[TR]
[TD]AAA[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]BBB, AAA[/TD]
[/TR]
[TR]
[TD]CCC[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]DDD, BBB[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]AAA, CCC[/TD]
[/TR]
[TR]
[TD]CCC[/TD]
[/TR]
</tbody>[/TABLE]

Before:

[TABLE="width: 100"]
<tbody>[TR]
[TD]Data[/TD]
[/TR]
[TR]
[TD]#N/A[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]#N/A[/TD]
[/TR]
[TR]
[TD]CCC[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]#N/A[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]AAA, CCC[/TD]
[/TR]
[TR]
[TD]CCC[/TD]
[/TR]
</tbody>[/TABLE]


What I am trying to do: I transformed "Criteria" into an array arrCriteria = {AAA;BBB;CCC;...}. Then I go to the data column, loop through it and each cell. If the cell is empty, then I don't need to do anything. If I found a comma in a data cell, then I need to check whether that cell is a full subset of arrCriteria (e.g. "AAA, BBB" or "CCC, BBB"). Then I will need a statement if there is only one entry, e.g. only "AAA", "BBB", "CCC"...

Here is what I have so far:

Sub SubsetArray()

    lastRow = Criteria.Cells(Rows.Count, "D").End(xlUp).Row


    Dim txt As String
    
    Dim FullName As Variant
    Dim cell As Range
    Dim j As Long
    Dim k As Long
    Dim l As Long
    Dim data As Worksheet
    Dim Criteria As Worksheet
    
    Set data = ThisWorkbook.Sheets("PBEXP")
    Set Criteria = ThisWorkbook.Sheets("Verticals")


    arrCriteria = Join(Application.Transpose(Criteria.Range("D2:D" & lastRow).value), "#")
  
    Deleteme = Split(arrCriteria, "#")


    lastRow = data.Cells(Rows.Count, "B").End(xlUp).Row
      
    On Error Resume Next
    
    For Each cell In data.Range(data.Cells(2, 10), data.Cells(lastRow, 10))
    
        txt = cell.value ' current cell content
        
        ' If cell is empty, then do nothing
        If IsEmpty(txt) Then ' if cell is empty then skip
    
        ' If a comma is found, then check if subset is found
        ElseIf InStr(1, txt, ", ") > 0 Then
        
              FullName = Split(txt, ", ") ' split cell content into array txt
    
              For j = LBound(FullName) To UBound(FullName)
                  For k = LBound(Deleteme) To UBound(Deleteme)
                
                      If FullName(j) <> Deleteme(k) Then
                                                                                                       
                      Else if FullName(j) = Deleteme(k) then
                          
                      data.Columns("J").Replace txt, "#N/A", xlWhole, , False, False, False
                     
                      End If
                     
                  Next k
              Next j
        End If
        
    Next cell
    
  End Sub

 

[Fluff]

How did the data get into the column?
Did you copy data that contain formulae & pastevalues

 

[fxrexcel]

I received an export. I copied the data to another sheet, but still shows FALSE for some cells even though they are empty.

Only when I click on a cell + F2 + DELETE + Enter makes them blank. Any way do that for all of them via vba?

 

[Fluff]

You can try this to start with

Sub Chk()
With Range("J:J")
   .Value = .Value
End With
End Sub

If that doesn't work try =TRIM(CLEAN(J3)) & then paste the result as value back into J3 & see if that works

 

[fxrexcel]

Fluff, many thanks for your time and effort. It works now finally! great job!

 

[Fluff]

Glad to help & thanks for the feedback