Thread: Can you Remove Both Duplicates?

mayhem12,

Something like this?

Sub tgr()
    
    With ActiveSheet.UsedRange
        With Cells(.Row, .Column + .Columns.Count).Resize(.Rows.Count)
            .Formula = "=ConcatRng(" & Range(Cells(.Row, ActiveSheet.UsedRange.Column), Cells(.Row, .Column - 1)).Address(0, 0) & ")"
            .Offset(0, 1).Formula = "=if(countif(" & .Address & "," & Cells(.Row, .Column).Address(0, 0) & ")>1,1,0)"
            .Offset(0, 1).AutoFilter 1, 1
            .Offset(1).EntireRow.Delete
            .Offset(0, 1).AutoFilter
            .Resize(, 2).EntireColumn.Delete
        End With
    End With
    
End Sub

Public Function ConcatRng(Rng As Range) As String
    
    Dim c As Range
    For Each c In Rng
        ConcatRng = ConcatRng & c.Value
    Next c
    
End Function