PDA

View Full Version : Remove Duplicate VBA



Svmaxcel
10-02-2017, 03:48 PM
Its a common task to remove duplicates in excel via VBA
I understood the concept of removing duplicates, Range(Address).RemoveDuplicates Columns:=Array(Columns list)

File attached for reference.
My file has columns number, name,analysis1,analysis2,Description.
When I paste data in the sheet sometimes duplicate data also comes.
Here is the catch for 2 columns
If Number, Name are same, I will use remove duplicates by selecting 2 columns.

For 3 columns I will use it for array 1,2,3
Now if Name and Numbers are Same, but analysis1 is blank for 1, VBA will not remove it thinking its unique.

p45cal
10-03-2017, 04:14 AM
What an interesting problem; I can see it arising many times, but there doesn't seem to be a built-in solution for it. I'm short on time at the moment, but I recorded this macro on your sheet (tarted it up a bit, it could be a lot shorter still and more general but I leave that to you).
Does it do what you want and can you adapt it?

Sub Macro3()
With ActiveSheet
.Range("$A$1:$E$7").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
With .Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A1:E5")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
.Range("C1:C5").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=IF(COUNTIFS(R1C1:R5C1,RC[-2],R1C2:R5C2,RC[-1])>1,R[-1]C,"""")"
.Range("$A$1:$E$5").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
.Range("C1:C5").Value = .Range("C1:C5").Value
End With
End Sub

Bob Phillips
10-03-2017, 05:27 AM
Why not add the formula up-front


Dim lastrow As Long

With ActiveSheet

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("C1").Resize(lastrow).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=IF(COUNTIFS(R1C1:R" & lastrow & "C1,RC[-2],R1C2:R" & lastrow & "C2,RC[-1])>1,R[-1]C,"""")"
.Range("$A$1:$E$1").Resize(lastrow).RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End With

p45cal
10-03-2017, 05:50 AM
Why not add the formula up-frontYes, I thought I'd only need to use RemoveDuplicates once, the data should be sorted to ensure that blank cells have cells above them that correspond to their columns 1 & 2.

Paul_Hossler
10-03-2017, 07:24 AM
Q1 -- Am I correct in thinking that the 2 marked rows should be deleted because they're dups?

20555

Row 5 = Row 3 (2 column check) , and Row 4 = Row 2? (3 column check)


Q2 -- you only mention 3 columns. If D4 was "Very Rude" would row 4 still be considered a dup of row 2? (i.e. No 4 column check)

Svmaxcel
10-04-2017, 08:42 PM
Row 5 = Row 3 (2 column check) , and Row 4 = Row 2? (3 column check) : Yes


Q2 -- you only mention 3 columns. If D4 was "Very Rude" would row 4 still be considered a dup of row 2? (i.e. No 4 column check) : Yes.
It should be duplicate till the time, description is not filled