Remove Duplicates from Random Cells using Excel VBA - vba

Question

I have an excel sheet where I've duplicate values in difference cells. BUT the catch here is all those cells are not adjacent to one another. I'll randomly select those cells manually from the sheets & want to remove the duplicates.
In below screenshot I've selected random cells with value "test". I would like to remove the duplicates from selected cells.
Apologies : Adding possible scenario. Need only first occurrence of any repetitive cells. Remove remaining occurrences. It means it should give A1=TEST & B6=WEST. all other cell values should be removed.

Answer 1

Assuming that you have already made the random selection:
Sub dural()
Dim v As Variant, r As Range
v = ActiveCell.Text
addy = ActiveCell.Address
For Each r In Selection
If Not addy = r.Address Then
If r.Value = v Then
r.ClearContents
End If
End If
Next r
End Sub

Answer 2

Just for fun, here's a non-looping version. It does wipe out the ActiveCell's value and then reassign it, which worked in all situations in my limited testing:
Sub RemoveAllSelectionCellsExceptActiveCell()
Dim ActiveCellValue As Variant
ActiveCellValue = ActiveCell.Formula
Selection.Clear
ActiveCell.Formula = ActiveCellValue
End Sub
EDIT: Response to your edited question
This relies on the fact that adding a duplicate to a collection generates an error. If that happens, the cell in question is added to a range of cells to delete. Note that it will treat a cell with "=2" as different from a cell with "2":
Sub RemoveAllSelectionCellsExceptActiveCell2()
Dim cell As Excel.Range
Dim collDupes As Collection
Dim DupeCells As Excel.Range
Set collDupes = New Collection
For Each cell In Selection.Cells
On Error Resume Next
collDupes.Add cell.Formula, cell.Formula
If Err.Number <> 0 Then
If DupeCells Is Nothing Then
Set DupeCells = cell
Else
Set DupeCells = Union(DupeCells, cell)
End If
End If
On Error GoTo 0
Next cell
DupeCells.Clear
End Sub

Answer 3

And another...
If you want to clear the cells' contents and formatting and leave the cursor in the ActiveCell with no selected cells highlighting.
Note, when you make your selection, it will be the last cell visited that is the ActiveCell whose contents will remain, and remain selected.
Option Explicit
Sub remSelDup()
Dim ac As Range, c As Range
Set ac = ActiveCell
For Each c In Selection
If c = ac And c.Address <> ac.Address Then
c.Clear
End If
Next c
ac.Select
End Sub

Answer 4

There should be more than a few Find/FindNext examples on this site but here's another one.
Dim fnd As Range, fcl As Range, searchTerm As Variant
With ActiveSheet
Set fcl = ActiveCell
searchTerm = fcl.Value
Set fnd = .Cells.Find(What:=searchTerm, After:=fcl, LookIn:=xlValues, LookAt:= _
xlWhole, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
Do While fcl.Address <> fnd.Address
fnd.ClearContents
Set fnd = .Cells.FindNext(After:=fcl)
Loop
End With