Excel: Compare two columns (namelists), combine in third column

I want to compare two columns that contain lists of names. Most of the names in the first column are also in the second column. I want to create a third column that combines b开发者_开发百科oth columns and removes the duplicate names.

---

Can accomplish this sort of thing with less code using Collections. The following litte routine will collect all the unique values from any range (such as your 1st two cols):

Private Function UniqueVals(rgArea As Range) As Collection
    Set UniqueVals = New Collection
    Dim rgCell As Range
    For Each rgCell In rgArea.Cells
        On Error Resume Next: Call UniqueVals.Add(rgCell.Value, CStr(rgCell.Value)): On Error GoTo 0
    Next rgCell
End Function  

To see it in action here's a little test routine that operates on whatever cells are currently selected on the active sheet and debug.prints the results to the (Ctrl-G) immed window:

Public Sub Test()
    Dim vItem As Variant
    For Each vItem In UniqueVals(Selection)
        Debug.Print vItem
    Next vItem
End Sub

---

This will work. Define your ranges as required.

Sub combineNames()
    Dim varCol1, varCol2, varCol3
    Dim numDuplicates As Long
    Dim i1 As Integer
    Dim i2 As Integer
    Dim booIsDuplicate As Boolean

    ' Get names from sheet, put in Variant array
    varCol1 = Range("E1:E6")
    varCol2 = Range("F1:F6")

    ReDim varCol3(1 To UBound(varCol1, 1) + UBound(varCol2, 1), 1 To 1)

    ' Insert all names from 1st column
    For i1 = 1 To UBound(varCol1, 1)
        varCol3(i1, 1) = varCol1(i1, 1)
    Next i1

    ' Insert names from 2nd column if not duplicate
    numDuplicates = 0
    For i2 = 1 To UBound(varCol2, 1)
        booIsDuplicate = False
        ' Check if already in 3rd column
        For i1 = 1 To UBound(varCol1, 1)
            If varCol2(i2, 1) = varCol3(i1, 1) Then
                ' It's a duplicate.
                booIsDuplicate = True
                numDuplicates = numDuplicates + 1
                Exit For
            End If
        Next i1
        If booIsDuplicate = False Then
            ' It's not a duplicate; add it to the list.
            varCol3(i2 + UBound(varCol1, 1) - numDuplicates, 1) _
                = varCol2(i2, 1)
        End If
    Next i2

    ' Put combined name list back in sheet.
    Range("G1").Resize( _
        UBound(varCol1, 1) + UBound(varCol2, 1) - numDuplicates, 1) = varCol3

End Sub

---

If you want to avoid using macros and your sheet doesn't contain a prohibitively large number of rows, you could simply copy the values from Column A and paste them into Column C, then copy the values from Column B and paste them at the end of Column C. Then, you would just have to select Column C and use the 'Remove Duplicates' tool (found on the Data menu).

Note: If Columns A or B contain formulas, you will want to Paste the values only using PasteSpecial.

---

I propose to scan each column seperately (maybe you have duplicates within one column) and append to 3rd column if unique. This is maybe more modular than you need, but you can maybe re-use individual sub's / functions

Assumption: no blank cells within columns

Sub Merge()
Dim S1 As Range, S2 As Range, T As Range

    Set S1 = ActiveSheet.[A1]   ' 1st cell of 1st Source column
    Set S2 = ActiveSheet.[B1]   ' 1st cell of 2nd Source column
    Set T = ActiveSheet.[C1]    ' 1st cell of Target range

    ScanCol S1, T
    ScanCol S2, T

End Sub

Sub ScanCol(S As Range, T As Range)
Dim Idx As Long, Jdx As Long

    Idx = 1
    Do While S(Idx, 1) <> ""
        Jdx = GetKey(S(Idx, 1), T)
        If Jdx <> 0 Then
            T(Jdx, 1) = S(Idx, 1)
        End If
        Idx = Idx + 1
    Loop
End Sub

Function GetKey(S As String, T As Range) As Long
Dim Idx As Long, IsFound As Boolean

    GetKey = 0
    IsFound = False
    Idx = 1

    Do While T(Idx, 1) <> ""
        If T(Idx, 1) = S Then
            IsFound = True
            Exit Do
        End If
        Idx = Idx + 1
    Loop

    If Not IsFound Then
        GetKey = Idx            ' return number of first blank line
    End If

End Function

Result

A   A   A
B   C   B
C   E   C
A   F   E
E   G   F
    H   G
        H