Remove duplicate rows in excel using vba

Question

I have a column of data in which i have string values. I want to do a comparison by each cell in that column and check whether the value is a duplicate or not. The comparison needs to be both full text as well as wild cards.

below is the screenshot of my data

if you see the screenshot, the company CES Limited exist in the row 3 as well as on row 17 along with another company ECLERX SERVICES LTD | CES Limited. So I want to highlight the duplicate values like this.

Below is the code I wrote

Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer

Set rangeToUse = Selection

Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone

For Each singleArea In rangeToUse.Areas
    singleArea.BorderAround ColorIndex:=1, Weight:=xlThin
Next singleArea

For i = 1 To rangeToUse.Areas.Count
    For Each cell1 In rangeToUse.Areas(i)
    MsgBox cell1.Value
        For j = 1 To rangeToUse.Areas.Count
                For Each cell2 In rangeToUse.Areas(j)
                    If cell1.Value = cell2.Value Then
                        cell2.Interior.ColorIndex = 38
                    End If
                    MsgBox cell2.Value
                Next cell2
        Next j
    Next cell1
Next i

however the code highlights all the cells as different. Can anyone let me know where I am doing wrong?

When it comes to creating a list of unique values in Excel, nothing beats a good old [`Dictionary` object](http://stackoverflow.com/questions/915317/does-vba-have-dictionary-structure). — Tim, Jun 23 '16 at 11:14
They will be the same color because when you iterate through the list, at some point, `cell1` and `cell2` will refer to the same cell, which of course, will pass your match test. You need to exclude cell1 from being compared with itself. — Ron Rosenfeld, Jun 23 '16 at 12:07

score 0 · Answer 1 · answered Jun 23 '16 at 11:09

This will give you the number of occurrences in your Selection

WorksheetFunction.CountIf(rangeToUse, "" & cell2 & "")

It appear that your are iterating through a non-continuous selection. If you want to count the number of occurrences in cell2's area use

WorksheetFunction.CountIf(rangeToUse.Areas(j), "" & cell2 & "")

score 0 · Answer 2 · answered Jun 23 '16 at 11:54

It seems to me that you are coding to match exact cell values, but in your example you state that CES Limited and ECLERX SERVICES LTD | CES Limited should return a match.

You also need to consider how you're flagging this as different colours, what happens if ECLERX appears again on it's own/with something else, what colour does that turn?

You may be able to achieve this with a find if you really do just want to return duplicates as per the below code, if you need to seperate and colour code companies you will probably need to split the string in the cells, have a look if this works for you, it will flag where the entire string of one cell makes up a part of any other by placing a 1 in the column next to it:

Sub Whatever()

Dim Loc As Range
Dim Loc2 As Range
Dim cell As Range
Dim myrange As Range

Set myrange = -Put Your Range Here-

For Each cell In myrange

    Set Loc = myrange.Cells.Find(What:=cell.Value)
    Set Loc2 = myrange.FindNext(Loc)
    If Not Loc2.Address = Loc.Address Then

        Loc.Offset(0, 1) = 1

        Do Until Loc2.Address = Loc.Address Or Loc2.Offset(0, 1) = 1

            Loc2.Offset(0, 1) = 1
            Set Loc2 = myrange.FindNext(Loc2)

        Loop

    End If

Next cell

Set Loc = Nothing
Set Loc2 = Nothing

End Sub

score 0 · Accepted Answer · answered Jun 23 '16 at 12:45

Your code will always find duplicates as one of your comparisons will always be the cell with itself.

Here is a method using a Collection object to detect duplicates. A collection will return an error if you try to add an item with the same key as an existing item. We test for that.

We also need to split the company names when you have two (or more) in a cell. In your sample, they appear to be split by | (pipe surrounded by space), but check that as sometimes screenshots are not ideal.

See if this gets you started:

Option Explicit
Sub ColorDups()
Dim rangeToUse As Range, singleArea As Range, cell1 As Range, cell2 As Range, i As Integer, j As Integer
Set rangeToUse = [a1:a23] 'hard coded for testing

Cells.Interior.ColorIndex = 0
Cells.Borders.LineStyle = xlNone

For Each singleArea In rangeToUse.Areas
    singleArea.ClearFormats
    singleArea.BorderAround ColorIndex:=1, Weight:=xlThin
Next singleArea

'Generate Unique companies list and flag duplicates
Dim colCompanies As Collection
Dim vCompany As Variant
Dim S(0 To 1) As String
Set colCompanies = New Collection
On Error Resume Next
For i = 1 To rangeToUse.Areas.Count
    For Each cell1 In rangeToUse.Areas(i)
        vCompany = Split(cell1.Text, " | ")
        For j = LBound(vCompany) To UBound(vCompany)
            S(0) = Trim(vCompany(j))
            S(1) = cell1.Address
            colCompanies.Add S, S(0)
            Select Case Err.Number
                Case 457 'we have a duplicate
                    Err.Clear
                    cell1.Interior.ColorIndex = 38
                    Range(colCompanies(S(0))(1)).Interior.ColorIndex = 38
                Case Is <> 0 'debugstop
                    Debug.Print Err.Number, Err.Description
                    Stop
            End Select
        Next j
    Next cell1
Next i
On Error GoTo 0

End Sub

This is the result using your data and the above macro. You might enhance by using several different colors, and/or by outputting the matching cell ranges; etc.

Hi @Ron, Thanks... Your solution helped me. Thanks for your help. I will modify to have different colors — Karthik Venkatraman, Jun 23 '16 at 14:16

Remove duplicate rows in excel using vba

3 Answers3