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

The code for MergeDistinct is shown below:
Sub MergeDistinct()
Dim R As Range
Dim LastCell As Range
Dim WS As Worksheet
Dim N As Long
Dim M As Long
Dim StartList1 As Range
Dim StartList2 As Range
Dim StartOutputList As Range
Dim ColumnToMatch As Variant
Dim ColumnsToCopy As Long
ColumnToMatch = "C"
ColumnsToCopy = 3
Set StartOutputList = Worksheets("Sheet3").Range("A1")
Set StartList1 = Worksheets("Sheet1").Range("C1")
Set WS = StartList1.Worksheet
With WS
M = 1
Set LastCell = .Cells(.Rows.Count, StartList1.Column).End(xlUp)
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
StartOutputList(M, 1).Resize(1, ColumnsToCopy).value = _
R.Resize(1, ColumnsToCopy).value
M = M + 1
End If
End If
Next R
End With
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

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: 18-March-2009. |