VBA to remove all kinds of duplicates in excel

[nagasree]

I have a excel file which needs to be unique, I want to remove the duplicates, all kinds of duplicates like below

Going to data->remove duplicates is not working. i found a code, which is also not working

Sub SimpleExample()
ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3) , Header:=xlYes
End Sub


Can anyone help me with this Thanks in advance

 

[Peter_SSs]

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: VBA to remove all kinds of duplicates
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[alansidman]

This is the closest I can get it with Power Query

Book1
	A	B	C	D	E	F	G
1	Code	Name	Value		Code	Name	Value
2	1	color	multicolor		1	color	Multicolor
3	1	color	Multicolor		2	Fruit	Apple
4	1	color	Multicolor		2	Fruit	Apploe
5	1	color	multi color		3	Country	Unitedstates
6	1	color	Multi-color
7	2	Fruit	Apple
8	2	Fruit	apple
9	2	Fruit	Apple
10	2	Fruit	Apple.
11	2	Fruit	Apploe
12	3	Country	unitedstates
13	3	Country	United-States
14	3	Country	United States
15	3	Country	United states
Sheet1

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Trimmed Text" = Table.TransformColumns(Source,{{"Value", Text.Trim, type text}}),
    #"Capitalized Each Word" = Table.TransformColumns(#"Trimmed Text",{{"Value", Text.Proper, type text}}),
    #"Replaced Value" = Table.ReplaceValue(#"Capitalized Each Word",".","",Replacer.ReplaceText,{"Value"}),
    #"Replaced Value1" = Table.ReplaceValue(#"Replaced Value","-"," ",Replacer.ReplaceText,{"Value"}),
    #"Replaced Value2" = Table.ReplaceValue(#"Replaced Value1"," ","",Replacer.ReplaceText,{"Value"}),
    #"Uppercased Text" = Table.TransformColumns(#"Replaced Value2",{{"Value", Text.Upper, type text}}),
    #"Capitalized Each Word1" = Table.TransformColumns(#"Uppercased Text",{{"Value", Text.Proper, type text}}),
    #"Removed Duplicates" = Table.Distinct(#"Capitalized Each Word1")
in
    #"Removed Duplicates"

 

[Peter_SSs]

You could test this. You will have to adjust the ranges to suit your data location.
All results will have no spaces or non-letter characters in them as I couldn't see how else to make all those items (that clearly are not duplicates) into duplicates.

Sub Dedupe()
  Dim a As Variant
  Dim i As Long
 
  a = Range("C3", Range("E" & Rows.Count).End(xlUp)).Value
  With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "[^A-Za-z]"
    For i = 2 To UBound(a)
      a(i, 3) = .Replace(a(i, 3), "")
    Next i
  End With
  With Range("H3:J3").Resize(UBound(a))
    .Value = a
    .RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
  End With
End Sub

My sample data (C:E) and code result (H:J)

nagasree.xlsm
	C	D	E	F	G	H	I	J
1
2
3	Code	Name	Value			Code	Name	Value
4	1	color	multicolor			1	color	multicolor
5	1	color	Multicolor			2	Fruit	Apple
6	1	color	Multicolor			3	Country	unitedstates
7	1	color	multi color
8	1	color	Multi-color
9	2	Fruit	Apple
10	2	Fruit	apple
11	2	Fruit	Apple
12	2	Fruit	Apple.
13	2	Fruit	Apple
14	3	Country	unitedstates
15	3	Country	United-States
16	3	Country	United States
17	3	Country	United states
Sheet1