VBA : Remove duplicate rows (not cells) from a table

E

ExcelJohn

Board Regular
Joined
Mar 29, 2011
Messages
52
Dear All,

I need your help. I have a sheet called "Total", with data in the first three columns.

This is an example of how the sheet looks like :
A,B,C
------
john@provider.com,UK, Oct2007
doe@hotmail.name,France, Feb2011
eric@fusemail.net,Added from Norway, Nov93
john@provider.com,United Kingdom, Oct2003
doe@hotmail.name,Paris, Feb1993
[...]

I would like to delete the duplicate row based on the email address, but I need to conserve the two 'B'-column values (joining them) + the two 'C'-column values (joining them), so the sheet will look like :

A,B,C
------
john@provider.com,UK - United Kingdom, Oct2007 - Oct2003
doe@hotmail.name,France - Paris, Feb2011 - Feb1993
eric@fusemail.net,Added from Norway, Nov93
[...]

How would I do that ? I need help.

Thanks,
John
 

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.
Sort by date Sort by votes
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG09May09
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Del [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
ReDim ray(1 To Rng.Count)
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
       [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.value, Array(Dn.Offset(, 1), Dn.Offset(, 2))
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(Dn.value)
                c = c + 1
                ray(c) = Dn.row
                Range(Q(0).Address) = Range(Q(0).Address) & " - " & Dn.Offset(, 1)
                Range(Q(1).Address) = Range(Q(1).Address) & " - " & Dn.Offset(, 2)
               .Item(Dn.value) = Q
        [COLOR="Navy"]End[/COLOR] If
       
    [COLOR="Navy"]Next[/COLOR]
    [COLOR="Navy"]For[/COLOR] Del = c To 1 [COLOR="Navy"]Step[/COLOR] -1
        rows(ray(Del)).EntireRow.Delete
    [COLOR="Navy"]Next[/COLOR] Del
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Hi Mick, and thanks again.

How would I do it to specify a sheet to work with ? I have different sheets in the excel file and I want it to do it for sheet called "Total".

Also, how would I output in a msgbox saying how many duplicated entries have been found ?

Regards
 
Last edited:
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG09May39
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Del [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Gt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] msg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Total")
 [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
ReDim ray(1 To Rng.Count)
    [COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
       [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.value) [COLOR="Navy"]Then[/COLOR]
                .Add Dn.value, Array(Dn.Offset(, 1), Dn.Offset(, 2), 0)
            [COLOR="Navy"]Else[/COLOR]
                Q = .Item(Dn.value)
                c = c + 1
                Q(2) = Q(2) + 1
                ray(c) = Dn.row
                Range(Q(0).Address) = Range(Q(0).Address) & " - " & Dn.Offset(, 1)
                Range(Q(1).Address) = Range(Q(1).Address) & " - " & Dn.Offset(, 2)
               .Item(Dn.value) = Q
        [COLOR="Navy"]End[/COLOR] If
       
    [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] Del = c To 1 [COLOR="Navy"]Step[/COLOR] -1
    rows(ray(Del)).EntireRow.Delete
[COLOR="Navy"]Next[/COLOR] Del
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    [COLOR="Navy"]If[/COLOR] .Item(K)(2) > 0 [COLOR="Navy"]Then[/COLOR]
        msg = msg & K & " = " & .Item(K)(2) & Chr(10)
        Gt = Gt + .Item(K)(2)
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] K
MsgBox "Duplicates" & Chr(10) & msg & Chr(10) & "Total Dups = " & Gt
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
@Mick:

That is neat! I was trying it before posting what I had come up with...
Just to mention, wouldn't we need to also qualify Range(Q(0).Address) = Range(Q(0).Address)...
 
Upvote 0
Hi, GTO Not sure what you mean ??
wouldn't we need to also qualify Range(Q(0).Address) = Range(Q(0).Address)...
Click to expand...
But what i should have done , is because the "Q" references are actual range objects, I should have coded it as shown in red, which is a lot neater.

Code: 
[COLOR=navy]Sub[/COLOR] MG09May32
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] Dn [COLOR=navy]As[/COLOR] Range
[COLOR=navy]Dim[/COLOR] c [COLOR=navy]As[/COLOR] [COLOR=navy]Integer[/COLOR]
[COLOR=navy]Dim[/COLOR] Del [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] Q [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] Gt [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant
[COLOR=navy]Dim[/COLOR] msg [COLOR=navy]As[/COLOR] [COLOR=navy]String[/COLOR]
[COLOR=navy]With[/COLOR] Sheets("Total")
 [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("A1"), .Range("A" & rows.Count).End(xlUp))
[COLOR=navy]End[/COLOR] With
ReDim ray(1 To Rng.Count)
    [COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
        .CompareMode = vbTextCompare
    [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
       [COLOR=navy]If[/COLOR] Not .Exists(Dn.value) [COLOR=navy]Then[/COLOR]
                .Add Dn.value, Array(Dn.Offset(, 1), Dn.Offset(, 2), 0)
            [COLOR=navy]Else[/COLOR]
                Q = .Item(Dn.value)
                c = c + 1
                Q(2) = Q(2) + 1
                ray(c) = Dn.row
                [COLOR=red][B]Q(0).value = Q(0).value & " - " & Dn.Offset(, 1)[/B][/COLOR]
[COLOR=red][B]                Q(1).value = Q(1).value & " - " & Dn.Offset(, 2)[/B][/COLOR]
               .Item(Dn.value) = Q
        [COLOR=navy]End[/COLOR] If
 
    [COLOR=navy]Next[/COLOR]
[COLOR=navy]For[/COLOR] Del = c To 1 [COLOR=navy]Step[/COLOR] -1
    rows(ray(Del)).EntireRow.Delete
[COLOR=navy]Next[/COLOR] Del
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    [COLOR=navy]If[/COLOR] .Item(K)(2) > 0 [COLOR=navy]Then[/COLOR]
        msg = msg & K & " = " & .Item(K)(2) & Chr(10)
        Gt = Gt + .Item(K)(2)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] K
MsgBox "Duplicates" & Chr(10) & msg & Chr(10) & "Total Dups = " & Gt
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]
Regards Mick
 
Upvote 0
Mick,

The part about displaying the total number of dupes works great.

However, the thing about working with sheet "Total" doesn't. It indeed looks for the dupes in that sheet, but it places the B and C column values in the currently working sheet, and this is a problem.

How do I fix it ?

Thanks.
 
Last edited:
Upvote 0
Sorry Mick this last code doesn't work.

It merges the values in B and C in the sheet 'Total', but :
- It doesn't delete the rows in sheet "Total"
- It deletes two rows in the current working sheet
 
Upvote 0
Sorry , I forgot that bit !!
Change the line as shown below:-
Rich (BB code): 
For Del = c To 1 Step -1
    Sheets("Total").rows(ray(Del)).EntireRow.Delete
Next Del
Regards Mick
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Convert Parent-Child into Excel Hierarchy using VBA
Replies
6
Views
985
shaowu459
shaowu459
L
  • Solved
Finding numbers in cell with text
2
Replies
10
Views
266
Lancer7
L
A
  • Question Question
Excel Function to Extract Text String, Remove Duplicate & Count
Replies
5
Views
315
arijitirf
A
J
  • Solved
VBA to search for duplicates, concatenate cells from another column and delete row
Replies
5
Views
279
Alex Blakenburg
A
N
  • Question Question
VBA to remove all email addresses from cells
Replies
1
Views
460
AlphaFrog
AlphaFrog

Forum statistics

Threads
1,224,609
Messages
6,179,881
Members
452,948
Latest member
Dupuhini

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top