Good day. I have sheet with 2 columns A and B. I want to know if how many in the items in Column A and are not mapped to Column B and display it if what are those items. Thank you so much.

Click to view image

CodePudding user response：

Return Not Matching Items

Excel

Plain

=UNIQUE(FILTER(A2:A21,ISNA(XMATCH(A2:A21,B2:B21))))

LET

=LET(vCol,A2:A21,lCol,B2:B21,fInc,ISNA(XMATCH(vCol,lCol)),
    UNIQUE(FILTER(vCol,fInc)))

LET Variables

vCol - Value Column
lCol - Lookup Column
fInc - Filter Include

VBA

Sheet Module e.g. Sheet1

Private Sub Worksheet_Activate()
    CheckMappings Me
End Sub

The rest goes into one or more standard modules e.g. Module1.

Simple Test

Sub CheckMappingsTEST()
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    CheckMappings ws
End Sub

Main

Sub CheckMappings(ByVal ws As Worksheet)
    
    Const SEARCH_FIRST_CELL As String = "A2"
    Const MATCH_FIRST_CELL As String = "B2"
    
    Dim srg As Range: Set srg = RefColumn(ws.Range(SEARCH_FIRST_CELL))
    If srg Is Nothing Then Exit Sub
    Dim mrg As Range: Set mrg = RefColumn(ws.Range(MATCH_FIRST_CELL))
    If mrg Is Nothing Then Exit Sub
    
    Dim sData(): sData = GetColumnRange(srg)
    Dim sDict As Object: Set sDict = DictColumn(sData)
    If sDict Is Nothing Then Exit Sub
    
    Dim mData(): mData = GetColumnRange(mrg)
    Dim mDict As Object: Set mDict = DictColumn(mData)
    If mDict Is Nothing Then Exit Sub
    
    RemoveDictFromDict sDict, mDict
    
    If sDict.Count = 0 Then
        MsgBox "No items to fix.", vbInformation
    Else
        MsgBox "The following " & IIf(sDict.Count = 1, "item is", _
            sDict.Count & " items are") & " not mapped:" & vbLf & vbLf _
            & Join(sDict.Keys, vbLf) & vbLf & vbLf & "Please fix.", vbCritical
    End If
    
End Sub

The Help

Reference Non-Empty Column

Function RefColumn( _
    ByVal FirstCell As Range) _
As Range
    With FirstCell.Cells(1)
        Dim cel As Range: Set cel = .Resize(.Worksheet.Rows.Count - .Row   1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not cel Is Nothing Then Set RefColumn = .Resize(cel.Row - .Row   1)
    End With
End Function

Column To Array

Function GetColumnRange( _
    ByVal rg As Range, _
    Optional ByVal ColumnIndex As Long = 1) _
As Variant

    With rg.Columns(ColumnIndex)
        If .Rows.Count = 1 Then
            ReDim Data(1 To 1, 1 To 1): Data(1, 1) = .Value
        Else
            Data = .Value
        End If
    End With
    
    GetColumnRange = Data
    
End Function

Unique From Array to Dictionary

Function DictColumn( _
    Data() As Variant, _
    Optional ByVal ColumnIndex As Variant) _
As Object

    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' case-insensitive
    
    Dim c As Long
    
    If IsMissing(ColumnIndex) Then
        c = LBound(Data, 2) ' use first column index
    Else
        c = CLng(ColumnIndex)
    End If
    
    Dim Key As Variant
    Dim r As Long
    
    For r = LBound(Data, 1) To UBound(Data, 1)
        Key = Data(r, c)
        If Not IsError(Key) Then ' exclude error values
            If Len(CStr(Key)) > 0 Then ' exclude blanks
                dict(Key) = Empty
            End If
        End If
    Next r
   
    If dict.Count = 0 Then Exit Function ' only error values and blanks
    
    Set DictColumn = dict

End Function

Remove Matches

Sub RemoveDictFromDict( _
        ByRef RemoveDict As Object, _
        ByVal MatchDict As Object)
    
    Dim rkey As Variant
    
    For Each rkey In RemoveDict.Keys
        If MatchDict.Exists(rkey) Then RemoveDict.Remove rkey
    Next rkey
    
End Sub