Rename Duplicates

[daily106]

I searched on the board for duplicates and could not find what I needed.

How could I create a macro to rename the duplicate cells in a column and delete other cells that is not duplicate?

Is subtotal the only way to do this kinda job? Thank you all.

Book2
	A	B	C	D
1	Name	Count
2	IXC	2
3	BAS	1
4	TGB	1
5	WAV	5
6	BAS	3
7	IDT	3
8	ITA	9
9	FRA	8
10	QWE	8
11	FRA	7
12	IDT	6
13	ITA	13
14	TGB	2
15
16	Name	Count
17	IXC
18	BAS	Yes
19	TGB	Yes
20	WAV
21	BAS	Yes
22	IDT	Yes
23	ITA
24	FRA	Yes
25	QWE	Yes
26	FRA
27	IDT
28	ITA
29	TGB
Sheet1

 

[daily106]

Ok, let me try your formula and let you know if I have any questions. Sorry about not being so clear. sometimes I am juggling so much stuff at work, I am rushing to ask a question and apply the answer to the work I do.

Anyhow, this forum is helping me so much!! THANK YOU ALL!!!

 

[erik.van.geit]

Thank you Erik,

I tried your codes and it hides all duplicates. I need to delete unique cells in a column.

what would be the logic to rename the duplicates ?
After deleting all uniques, anything that appears in the column should be name to "Yes". Actually there is no logic since want to see where the duplicates are.

Hope it helps. Thank you.

sorry, I was distracted when posting my code
in fact the code should do automatically what shippey explained manually
here it is correctly

Option Explicit

Sub filter_duplicates()
'Erik Van Geit
'060317
'get list with data which appear more then once
'= uniques(range - uniques(range))
'no header needed
'autofilter with extra column would do the same
'START WITH
'a1 a2 a3 a4 a1 a1 a2 a2 a5 a6 a6 (in a column!)
'TO GET
'a1 a1 a1 a2 a2 a2 a6 a6

Dim LR As Long
Dim RNG As Range

Const CC As Integer = 1 'check column
Const FR As Long = 1    'first row with data

LR = Cells(Rows.Count, CC).End(xlUp).Row
Set RNG = Range(Cells(FR, CC), Cells(LR, CC))

'ActiveSheet.Copy
Application.ScreenUpdating = False
    Columns(CC).Insert
    With RNG.Offset(0, -1)
    .Formula = "=IF(COUNTIF(" & RNG.Address & "," & RNG(1).Address(0, 0) & ")>1,1,"""")"
    .Value = .Value
    On Error Resume Next
    .Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True '.Delete
    On Error GoTo 0
    End With
    Columns(CC).Delete
Application.ScreenUpdating = True
End Sub

it is HIDING the rows
if you find the result correct you can change Hidden to Delete (as you can see at the end of the line the word "delete" was already there !)

I do not see why you need a YES since all uniques will be deleted: can you explain ?

best regards,
Erik

 

[daily106]

Thank you Erik and all!

I was able to use the code by editing them and changing them.
Again, thank you very much!!