How to create a macro to move duplicates

Requirement:

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.

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1195844-move-duplicates

Solution:

Code:

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)
        Else
        Set r = Union(r, aRange.Areas(i).Rows(j))
      End If
NextJ:
    Next j
  Next i
  Set StripFirstRow = r
End Function

Obtained from the OzGrid Help Forum.

Solution provided by Kenneth Hobson.