How to create a macro to move duplicates

< Back to Search results

 Category: [Excel]  Demo Available 

How to create a macro to move duplicates




Column B contains alpha-numeric values and the user needs a formula or macro which will move the duplicates, search and move complete row once duplicate value is found in column B.






Sub MoveDupsAndKeepFirst()
  Dim r As Range, c As Range, cn As Integer, lr As Long, col$
  Dim wsU As Worksheet, wsD As Worksheet, rr As Range

  Set wsU = Worksheets("Uniques")
  Set wsD = Worksheets("Duplicates")
  col = "B"

  With wsU
    Set rr = .UsedRange
    Set r = .Range(col & 2, .Cells(Rows.Count, col).End(xlUp))
    cn = rr.Columns.Count
    lr = r.Rows.Count + 1
    'H2=COUNTIF(B$2:B$8,"=" & B2)-COUNTIF(B2:B$8,"=" & B2)
    .Cells(r.Row, cn + 1).Formula = "=COUNTIF(" & col & "$2:" & col & "$" & lr & "," & """" & "=" & """" & _
      "&" & col & "2)-COUNTIF(" & col & "2:" & col & "$" & lr & "," & """" & "=" & """" & "&" & col & "2)"
    .Cells(r.Row, cn + 1).Copy r.Offset(, cn - 1)

    'Filter, copy, and delete filtered rows.
    .UsedRange.AutoFilter cn + 1, ">0"
    With Intersect(StripFirstRow(.AutoFilter.Range.SpecialCells(xlCellTypeVisible)), rr)
      .Copy wsD.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      .Delete xlUp
    End With
    .AutoFilterMode = False

    Intersect(.UsedRange, .Columns(cn + 1)).Delete  'Delete helper column
  End With
  Application.CutCopyMode = False
End Sub

Function StripFirstRow(aRange As Range) As Range
  Dim i As Long, j As Long, r As Range, z As Long, idx As Long
  For i = 1 To aRange.Areas.Count
    For j = 1 To aRange.Areas(i).Rows.Count
      z = z + 1
      If z = 1 Then GoTo NextJ
      If r Is Nothing Then
        Set r = aRange.Areas(i).Rows(j)
        Set r = Union(r, aRange.Areas(i).Rows(j))
      End If
    Next j
  Next i
  Set StripFirstRow = r
End Function


Obtained from the OzGrid Help Forum.

Solution provided by Kenneth Hobson.


See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets


See also:

How to copy a sheet and rename from a list, ignore duplicates
How to use IndexMatch formula that ignores duplicates
How to find sequence of a column with duplicates
How to compare two workbooks with multiple sheets and highlighting duplicates


Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.


stars (0 Reviews)