Pagebanner

ThreeWave 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 of 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.

SectionBreak

The Code For MergeDistinct

download You can download the bas module file 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.

' This is the column in the input lists
' that is to be tested for duplicates.
ColumnToMatch = "C"

' This is the number of columns from each list to
' be merged that are copied to the result list.
ColumnsToCopy = 3

' The output list begins in this cell.
Set StartOutputList = Worksheets("Sheet3").Range("A1")

' The first list to be merged starts here.
Set StartList1 = Worksheets("Sheet1").Range("C1")
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("Sheet2").Range("C1")
Set WS = StartList2.Worksheet
With WS
    Set LastCell = .Cells(.Rows.Count, StartList2.Column).End(xlUp)
    For Each R In .Range(StartList2, LastCell)
        If R.value <> vbNullString Then
            N = Application.CountIf(StartOutputList.Resize(M, 1), _
                    R.EntireRow.Cells(1, ColumnToMatch).Text)
            If N = 0 Then
                StartOutputList(M, 1).Resize(1, ColumnsToCopy).value = _
                    R.Resize(1, ColumnsToCopy).value
                M = M + 1
            End If
        End If
    Next R
End With

End Sub

SectionBreak

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.

ShortFadeBar
LastUpdate This page last updated: 18-March-2009.

Created by Chip Pearson at Pearson Software Consulting, LLC
Email: chip@cpearson.com Before emailing me, please read this page
http://www.cpearson.com/excel/MergeListsToDistinct.aspx
Copyright © 1997 - 2009, Charles H. Pearson

Submit bug information or errors on the Bug And Error Report Page.



 


sectionbreak
Essential Tools For Developers


  

Essential Tools For Financial Analysts And Accounting Professionals

  
Ready


Advertise Your Product On This Site