Macro: Move Duplicate Rows From One Worksheet To Another

I am using Excel 2007 on Windows 7 Home Premium 64bit.

I have searched the forum, but have not been able to find an
example that does exactly what I am trying to do.

My Workbook contains 2 Worksheets, both with the same headings in row 1.
Sheet2 is initially empty, except for the headings in row 1.

I would be grateful to learn how to create a Macro as described below.

The following is a sample of the data in Sheet1:

     A      B       C            D        E      F
 1 First  Last   Address      City      State  Zip
 2 John	  Smith	 123 Main St  New York  NY     10021
 3 Mary	  Smith	 123 Main St  New York  NY     10021
 4 John	  Smith	 123 Main St  New York  NY     10021
 5 John	  Smith	              New York  NY     10021
 6 Joe	  Smith  123 Main St  New York  NY     10021
 7 Jack	  Smith  123 Main St  New York  NY     10021
 8 John	  Smith  123 Main St  New York  NY     10021
 9 Mary	  Smith  123 Main St  New York  NY     10021
10 Bill	  Smith               New York  NY     10021
11 John	  Smith	              New York  NY     10021
12 John	  Smith  124 Main St  New York  NY     10021

I want to create a Macro to operate as follows:

In the above sample data, rows 2, 4, and 8 are identical,
so I want to copy rows 4 and 8 to Sheet2, and delete them from Sheet1.

Similarly:
rows 3 and 9 are identical, so row 9 should move to Sheet2;
rows 5 and 11 are identical, so row 11 should move to Sheet2.

Rows 6, 7, 10, and 12 are all unique, so should be unaffected by the Macro.

New records will be added to Sheet1 periodically, so the Macro will be used
each time to move any newly discovered duplicates to Sheet2.

The Macro should make no assumption about how the rows are ordered,
and should not change their order.

I have uploaded two Workbooks, such that Workbook1 shows the
original data, and Workbook2 shows the result I want to obtain.

Originally Posted by MarvinP

Hi Dave and welcome to the forum,

Deleting duplicates is a pretty easy operation. See http://office.microsoft.com/en-us/ex...010073943.aspx

Why would you want to copy duplicates to another worksheet/workbook? No VBA or macro needed to do this problem if you can live without having a second workbook.

Thanks for the welcome.

I know that duplicates can be removed by manual procedures,
but the end user wants to be able to hand the Workbook to
data entry clerks who will be able to run the described Macro
by clicking a command button.

Likewise, the appending of duplicate rows to Sheet2 is what the
end user wants, for reasons I do not know.

ahhh here goes my solution but it will not work for you though. With this specification will be hard to go around this one without a loops. This code will give you a list of unique values. and the original data untouched.

Sub GetNoDuplicates()
    
    Dim shRaw As Worksheet
    Dim shClean As Worksheet
    Dim rData As Range
    Dim rHeaders As Range
    Dim lRow As Long
    
    
    ' Change this to what your sheets will be named.
    Set shRaw = Sheets("Raw Data")
    Set shClean = Sheets("Clean Data")
    
    
    ' Get the range of data and the headers
    Set rData = shRaw.Range("A1").CurrentRegion
    Set rHeaders = shRaw.Range("A1").CurrentRegion.Resize(1)
    
    ' Get the last row with data and add  to separate
    ' them from the real data.
    lRow = shRaw.UsedRange.Rows.Count + 2
    
    
    ' Apply an advanced filter.
    rData.AdvancedFilter Action:=xlFilterCopy, _
                         CriteriaRange:=rHeaders, _
                         CopytoRange:=shRaw.Range("A" & lRow), _
                         Unique:=True
    
    ' Clear the values in the clean sheet.
    shClean.Cells.Clear
    
    ' Move the filtered data to the clean
    shRaw.Range("A" & lRow).CurrentRegion.Cut Destination:=shClean.Range("A1")
    
    
    ' Clean up objcet variables
    Set shRaw = Nothing
    Set shClean = Nothing
    Set rData = Nothing
    Set rHeaders = Nothing
    
End Sub

Originally Posted by fredlo2010

ahhh here goes my solution but it will not work for you though. With this specification will be hard to go around this one without a loops. This code will give you a list of unique values. and the original data untouched.
...

I agree that your code will not accomplish what I need to do,
but perhaps I may be able to extend it to my purpose if no
better solution is proposed.

As I said in my previous post, I do not know why the end user
wants to accumulate the duplicate rows in a second Worksheet,
although I guess it may be to create an audit trail with which to
belabor the data providers.

Try this

Sub test()
    Dim dic As Object, i As Long, x As Range
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("sheet1").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            If Not dic.exists(.Cells(i, 1).Value) Then
                dic(.Cells(i, 1).Value) = Empty
            Else
                If x Is Nothing Then
                    Set x = .Rows(i)
                Else
                    Set x = Union(x, .Rows(i))
                End If
            End If
        Next
        If Not x Is Nothing Then
            Union(.Rows(1), x).Copy Sheets("sheet2").Cells(1)
            x.EntireRow.Delete
        End If
    End With
End Sub

Originally Posted by jindon

Try this
...

Thank you, that is much closer to what I am trying to do;
however, if you compare the result produced by your function
to the desired result that I uploaded as Workbook2, you will
see that they are not quite the same.

Perhaps I did not make it clear, but a row should be considered
to be a duplicate only if it is identical, in every column, to some
other row.

OK, I thought it was just your mistake...
Change to

Sub test()
    Dim dic As Object, i As Long, ii As Long, x As Range, txt As String
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = 1
    With Sheets("sheet1").Cells(1).CurrentRegion
        For i = 2 To .Rows.Count
            For ii = 1 To .Columns.Count
                txt = txt & Chr(2) & .Cells(i, ii).Value
            Next
            If Not dic.exists(txt) Then
                dic(txt) = Empty
            Else
                If x Is Nothing Then
                    Set x = .Rows(i)
                Else
                    Set x = Union(x, .Rows(i))
                End If
            End If
            txt = ""
        Next
        If Not x Is Nothing Then
            Union(.Rows(1), x).Copy Sheets("sheet2").Cells(1)
            x.EntireRow.Delete
        End If
    End With
End Sub

OK, then cheange

        If Not x Is Nothing Then
            Union(.Rows(1), x).Copy Sheets("sheet2").Cells(1)
            x.EntireRow.Delete
        End If

to

        If Not x Is Nothing Then
            If IsEmpty(Sheets("sheet2").Range("a1")) Then
                Union(.Rows(1), x).Copy Sheets("sheet2").Cells(1)
            Else
                x.Copy Sheets("sheet2").Range("a" & Rows.Count).End(xlUp)(2)
            End If
            x.EntireRow.Delete
        End If

Originally Posted by jindon

OK, then cheange
...

Thank you, again, I am so immensely grateful for
your excellent advice.

I spoke to the end user this morning and confirmed,
as I suspected, that the reason for collecting
duplicate records in a separate Worksheet was as an
audit trail of data providers who were not submitting
clean data.

Another requirement, which I had omitted from my
original description of this project, was to collect
records with empty Address fields in another
Worksheet. I had already figured out how to do that,
so did not mention it in my original post on this
thread.

I will upload herewith the current version of the
Workbook, in the hope that it may be instructive to
others who might come up against a similar requirement.

I still have a few unanswered questions regarding
what I have learned so far. I will try to find the
answers on my own, but would appreciate any help I
can get.

1. I have not been able to find a formal definition
of what a UNION is.

2. I would like to know if there is some way of
prohibiting users of the Workbook from making any
changes to the first row (headings) of a Worksheet.

3. When the Workbook is handed off to users, is it
possible to prohibit them from viewing or modifying
the code?

4. I would love to know if, in adapting the code
and advice that has been given to me here so
generously, I have done anything especially stupid,
or have flouted any generally accepted VBA or Excel
conventions that I should be aware of.

I wonder where you read about variables for VBA and structure the code used here is very peculiar.

Thanks

Originally Posted by fredlo2010

I wonder where you read about variables for VBA and structure the code used here is very peculiar.

Thanks

I never studied VBA or Excel before yesterday,
so obviously I have a lot to learn.

For the most part, I have adapted conventions
from Visual Basic that I am comfortable with.

Despite any "peculiarities" that I may have incorporated
in my code, I am pleased to have achieved a solution
that seems to work as intended, and that I (mostly) understand.

Impressive work.

Give this page a read and you will be able to improve your code. http://en.wikibooks.org/wiki/Visual_...ding_Standards

Off the top of y head things that you can improve in your code:

• Give your variables dercripvive names, ( lLastRow, lLastColumn)
• No need to variable sufixes ($,&) those are kind obsolete use Dim lRow as long
• Declare all your variables.
  
  

  ' Just declaring one variable
  Dim lRow as long, lCol
  
  ' Better
  Dim lRow as long
  Dim lCol as long

• Learn the diffrence between Sub and Function

Just some ideas.

Originally Posted by fredlo2010

...
Just some ideas.

Thanks for the tips. The Wikibooks article appears to be very comprehensive and useful.

I always declare Option Explicit to make sure I don't forget to declare all variables & constants.

I obviously know the difference between a sub and a function.

I disagree that VarName as Long is any better than VarName&, and the latter is more concise.

I prefer to use short variable names, especially when they have limited scope,
e.g., i as the counter variable in a For ... Next loop.

1) Application.Union method enables you to select multiple ranges within a worksheet.
e.g

Dim r As Range
Set r = Application.Union(Range("A10"), Range("B5:C10"), Range("G2:G5"))
MsgBox r.Address

2) You can (password) protect the sheet.
3) You can password protect the VBA modules from viewing.
4) You can make any change at your own risk.

However, you should be aware that Excel is really weak in relation to protection.