Merging Lists To A List Of Distinct Values

This page describes code to merge two lists into a third list that does not contain duplicates.

Introduction

A common task in Excel is to merge two lists into a single list, usually preventing duplicates. This page describes code that you can use to merge two lists into a third list and prevent duplicate entries in the resulting list. The code, shown later, uses the following variables to control how the list is created.

StartList1
This variable should be set to the first cell of the first list to be merged. E.g.,
    Set StartList1 = Worksheets("Sheet1").Range("A1")

StartList2
This variable should be set to the first cell of the second list to be merged. E.g.,
    Set StartList2 = Worksheets("Sheet2").Range("A1")

StartOutputList
This variable should be set to the first cell where the merged list is to be created. E.g.,
    Set StartOutputList = Worksheets("Sheet3").Range("A1")

ColumnToMatch
This variable is either the column number or column letter of the values in both input lists that is to be tested for duplicates. E.g.,
   ColumnToMatch = 1 or
   ColumnToMatch = "A"

ColumnsToCopy
This variable is the number of columns, starting with ColumnToMatch, that should be copied from each input list to the merged list. E.g.,
    ColumnsToCopy = 3

It is not necessary for the input lists and the merged list to be on separate worksheets. However, under no circumstances should any of the three lists overlap with one another.

The Code For MergeDistinct

You can download an example workbook with all the code on this page.

The code for MergeDistinct is shown below:

Sub MergeDistinct()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MergeDistinct
' By Chip Pearson, chip@cpearson.com, www.cpearson.com
' This code: www.cpearson.com/Excel/MergeListsToDistinct.aspx
' This procedure merges two lists into a separate list
' that contains no duplicate values.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Dim R As Range          ' Range loop variable.
Dim LastCell As Range   ' Last cell in input columns.
Dim WS As Worksheet     ' Worksheet reference.
Dim N As Long           ' Result of duplicates test.
Dim M As Long           ' Rows in merged list.
Dim StartList1 As Range ' First cell of first list to merge.
Dim StartList2 As Range ' First cell of second list to merge.
Dim StartOutputList As Range    ' First cell of merged list.
Dim ColumnToMatch As Variant    ' Column in input lists to test for duplicates.
Dim ColumnsToCopy As Long       ' Number of columns in each input list to copy to output.
Dim V As Variant

' This is the column in the input lists
' that is to be tested for duplicates.
ColumnToMatch = "A" '<<<< Column containing original list

' This is the number of columns from each list to
' be merged that are copied to the result list.
ColumnsToCopy = 2 '<<<< Number of columns to copy per row

' The output list begins in this cell.
Set StartOutputList = Worksheets("Sheet1").Range("H3") '<<<< Merged output list begins here

' The first list to be merged starts here.
Set StartList1 = Worksheets("Sheet1").Range("A2") '<<< First input list begins here
Set WS = StartList1.Worksheet
With WS
    M = 1
    ' Get the last used cell in the first list to be merged.
    Set LastCell = .Cells(.Rows.Count, StartList1.Column).End(xlUp)
    ' Loop through the range of values
    For Each R In .Range(StartList1, LastCell)
        If R.Value <> vbNullString Then
            N = Application.CountIf(StartOutputList.Resize(M, 1), _
                    R.EntireRow.Cells(1, ColumnToMatch).Text)
            ' If N = 0, then the item is not in the merged result
            ' list, so copy the data over. If N > 0, we've already
            ' encountered the value, so do nothing.
            If N = 0 Then
                StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
                    R.Resize(1, ColumnsToCopy).Value
                ' M is the number of rows in the merged list. Increment it.
                M = M + 1
            End If
        End If
    Next R
End With

' The second list to be merged starts here.
Set StartList2 = Worksheets("Sheet1").Range("D3") '<<< Second input list begins here
Set WS = StartList2.Worksheet
With WS
    Set LastCell = .Cells(.Rows.Count, StartList2.Column).End(xlUp)
    For Each R In .Range(StartList2, LastCell)
        On Error Resume Next
        If R.Value <> vbNullString Then
            V = Application.Match(R.Text, StartOutputList.Resize(M + 1), 0)
            If V <> vbNullString Then
                If IsEmpty(V) = True Or IsError(V) = True Then
                    StartOutputList(M, 1).Resize(1, ColumnsToCopy).Value = _
                        R.Resize(1, ColumnsToCopy).Value
                    M = M + 1
                End If
            End If
        End If
    Next R
End With

End Sub

Merging Multiple Lists

If you need to merge multiple lists, you can merge the first two lists and use the merged output as input to a second merge, use the result of that merge as input to a third merge, and so on. For example,
Merge(List1, List2)  Merged1  Merge(Merged1, List3)  Merged2  Merge(Merged2, List4)  Final Merged List.

This page last updated: 3-January-2013.