Macro to move duplicate rows to another sheet

[zzman]

I am trying to write a macro that will move all duplicate rows based on column 3 into another sheet. For example:

Column 3
xyz
qwe
abc def
abc def gh

The last 2 rows are to be considered as duplicate and need to be deleted from this sheet and moved to another. My knowledge in macro scripting is very basic so please be detailed. Following is what i have so far:

Sub deleteDups()
    Dim i As Integer
    Dim colToMatch As Integer
    Dim wb As Workbook
    Dim dupsWs As Worksheet
    Dim ws As Worksheet
    Const dupsWsName = "Duplicate Rows"
        
    Set wb = ActiveWorkbook
    Set ws = wb.Worksheets(2)
    
    
    Application.DisplayAlerts = False
    
    'clean up, may exist if second run
    If sheetExists(dupsWsName) Then
        wb.Worksheets(dupsWsName).Delete
    End If
 
    'recreate
    wb.Worksheets.Add Before:=wb.Worksheets(1)
    Set dupsWs = ActiveSheet
    dupsWs.Name = dupsWsName
        
    i = 1 'Change this to 0 if no header
    colToMatch = 3 'no. of the column to match
    
    MsgBox ws.Name
    MsgBox dupsWs.Name
    
    '## Copy the header from the original to the new
    '## Loop through the original sheet and move the duplicate entries (i.e both the rows) 
    
    MsgBox "All done ..."
End Sub</pre>

 

[westconn1]

if you remove rows during a loop the loop can tend to loose its position as the total rows changes
you can start from the bottom and remove the rows moving up this will resolve that issue

for i = ws.usedrange.rows.count to 1 step -1
     if worksheetfunction.countif(ws.range("c1:c" & i - 1), ws.cells(i,3)) > 0 then ws.rows(i).delete
next

the countif function will return the number of times the value of column 3 is in the range above the current line

give it a try

oops forgot to copy to the new sheet first
ws.rows(i).entirerow.copy dupsws.range("a" & rownum)