Compare two list, extract missing names for second list

Question

I have a named range entitled "Names". I have a second list of names titled "Names_2". 

Using a macro, I need to compare the names that are in "Names" to the list of names in "Names_2" and if the name(s) are not found in Names_2, add it to the next available row(s).

Just in case you need cell references instead of named ranges...

Names =IDS!$A$2:$A$100

Names_2 ='NEW CHART DATA'!$B$5:$B$100

Both named ranges currently contain about 56 or so names ( the remaining cells to 100 is extra room to add more names without having to change range).

Answer 1

I have a named range entitled "Names". I have a second list of names titled "Names_2". 

Using a macro, I need to compare the names that are in "Names" to the list of names in "Names_2" and if the name(s) are not found in Names_2, add it to the next available row(s).

Just in case you need cell references instead of named ranges...

Names =IDS!$A$2:$A$100

Names_2 ='NEW CHART DATA'!$B$5:$B$100

Both named ranges currently contain about 56 or so names ( the remaining cells to 100 is extra room to add more names without having to change range).

Hi JW,

Alt-F11 to open the VBA editor

Alt-IM to insert a new code module

In the new module, paste the following code

'==========>>

Option Explicit

'---------->>

Public Sub Tester()

    '\ Insert a Reference to the library: Microsoft Scripting Runtime

    '\ Menu | Tools | References

    Dim WB As Workbook

    Dim aSH As Worksheet, bSH As Worksheet

    Dim aRng As Range, bRng As Range, destRng As Range

    Dim arrA As Variant, arrB As Variant, arrOut() As Variant

    Dim rCell As Range

    Dim aDic As Scripting.Dictionary, aUnique As Scripting.Dictionary

    Dim bDic As Scripting.Dictionary

    Dim aVal As Variant, bVal As Variant

    Dim i As Long, j As Long, aLastRow As Long, bLastRow As Long

    Set WB = ActiveWorkbook

    With WB

        Set aSH = .Sheets("IDS")

        Set bSH = .Sheets("NEW CHART DATA")

    End With

    With aSH

        aLastRow = LastRow(aSH, .Range("A2:A100"))

        Set aRng = .Range("A2:A" & aLastRow)

    End With

    With bSH

        bLastRow = LastRow(bSH, .Range("B5:B100"))

        Set bRng = .Range("B5:B" & bLastRow)

    End With

    arrA = aRng.Value

    arrB = bRng.Value

    Set aDic = New Scripting.Dictionary

    aDic.CompareMode = vbTextCompare

    Set bDic = New Scripting.Dictionary

    bDic.CompareMode = vbTextCompare

    Set aUnique = New Scripting.Dictionary

    aUnique.CompareMode = vbTextCompare

    For i = LBound(arrA) To UBound(arrA)

        aVal = arrA(i, 1)

        aDic(aVal) = vbNullString

    Next i

    For i = LBound(arrB) To UBound(arrB)

        bVal = arrB(i, 1)

        bDic(bVal) = vbNullString

    Next i

    On Error Resume Next

    For i = 0 To Application.Max(aDic.Count, bDic.Count) - 1

        aVal = aDic.Keys(i)

        bVal = bDic.Keys(i)

        If Not bDic.Exists(aVal) Then

            aUnique(aVal) = vbNullString

        End If

    Next i

    On Error GoTo 0

    j = aUnique.Count

    ReDim arrOut(1 To j)

    For i = 0 To j - 1

        arrOut(i + 1) = aUnique.Keys(i)

    Next i

    With bRng

        Set destRng = bRng.Offset(.Cells.Count).Resize(j)

        destRng.Value = Application.Transpose(arrOut)

    End With

    Set aDic = Nothing

    Set bDic = Nothing

    Set aUnique = Nothing

End Sub

'----------->>

Function LastRow(SH As Worksheet, _

                 Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       After:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<==========

Alt-T |References | Find and check Microsoft Scripting Runtime

Alt-Q to close the VBA editor

Alt-F8 to open the macro window

Select Tester | Run

===

Regards,

Norman

Answer 2

I will. Just in case...

Thanx

Answer 3

Hi,

Would you be willing to accept a non macro solution?