Option Explicit
'''''''IN SHEET1 FROM C1 RANGE U CAN PUT THE VALUE
''''''''DISTINCT VALUE CAN BE SEEN IN SHEET3 A1 RANGE
''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
Sub MergeDistinct()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MergeDistinct
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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
'''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''
On Thu, Dec 17, 2009 at 1:14 PM, Steve <sca...@aol.com> wrote:
> I have a few lists of names and dobs, each over 1,000 lines. I am
> trying to find names and dob's that are common to two lists. The
> names I want to pull out are the ones that are on each, if they are
> only on one list I am not interested in them.
>
> What I've done so far is paste two lists together, sort by dob and
> last name, and scroll down the list looking for duplicates. This is a
> PITA when the lists, pasted together, exceed 3,000 lines.
>
> Can anyone steer me to a better way of getting this done? I will be
> doing this routinely. There is one "master" list and I will be
> comparing a few other lists to this master list looking for people
> that appear on both.
>
> Thanks,
> Steve
>
> --
>
> ----------------------------------------------------------------------------------
> Some important links for excel users:
> 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
> http://www.excelitems.com
> 2. Excel tutorials at http://www.excel-macros.blogspot.com
> 3. Learn VBA Macros at http://www.vbamacros.blogspot.com
> 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
>
>
> To post to this group, send email to excel-macros@googlegroups.com
> If you find any spam message in the group, please send an email to:
> Ayush Jain @ jainayus...@gmail.com or
> Ashish Jain @ 26may.1...@gmail.com
> <><><><><><><><><><><><><><><><><><><><><><>
> HELP US GROW !!
>
> We reach over 6,500 subscribers worldwide and receive many nice notes about
> the learning and support from the group. Our goal is to have 10,000
> subscribers by the end of 2009. Let friends and co-workers know they can
> subscribe to group at
> http://groups.google.com/group/excel-macros/subscribe
--
----------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,500 subscribers worldwide and receive many nice notes about the
learning and support from the group. Our goal is to have 10,000 subscribers by
the end of 2009. Let friends and co-workers know they can subscribe to group at
http://groups.google.com/group/excel-macros/subscribe
