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
 
Sort by date Sort by votes
Aha! This works perfectly!

I have changed variable 'c' from Integer to Long because the table has ~40k entries.

I would like to ask to add another thing : If any of the cells that get merged are "blank", do not place a "-". Would that be possible ?

I am asking this because there's some rows with :
john@mrexcel.com,text1,
john@mrexcel.com,text2,
john@mrexcel.com,,
john@mrexcel.com,,

And then the result is :
john@mrexcel.com,text1 - text2 -, - -
 
Upvote 0

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Add the lines shown below in red.
This assumes that if a cell in column "B" is empty , then column "C" cell will also be empty !!
Rich (BB code): 
Else
                Q = .Item(Dn.value)
                c = c + 1
                Q(2) = Q(2) + 1
                ray(c) = Dn.row
                If Dn.Offset(, 1).value <> "" Then
                    Q(0).value = Q(0).value & " - " & Dn.Offset(, 1)
                    Q(1).value = Q(1).value & " - " & Dn.Offset(, 2)
                End If
               .Item(Dn.value) = Q
        End If
Mick
 
Upvote 0
Hmmm, nope Mike! There's some rows with empty "B" but data in "C".

Would it be possible to do it assuming this ?
 
Upvote 0
Try this:-
amend lines as shown:-

Rich (BB code): 
 Else
                Q = .Item(Dn.value)
                    c = c + 1
                    Q(2) = Q(2) + 1
                    ray(c) = Dn.row
                    If Dn.Offset(, 1).value <> "" Then Q(0).value = Q(0).value & " - " & Dn.Offset(, 1)
                    If Dn.Offset(, 2).value <> "" Then Q(1).value = Q(1).value & " - " & Dn.Offset(, 2)
                .Item(Dn.value) = Q
        End If
Mick
 
Upvote 0
Hey Mick,

This works very good. The are two small caveats :

- If there are two duplicate rows, the first one doesn't have any value in ColB or ColC, then the merged value starts with a "-", that I think it's not good because if it is a number can mislead to think that it's a minus sign instead of a separator.

- If there are three duplicate rows with values "1", "2", and "3" in ColC, when merged, instead of being 1-2-3, they are presented with DATE format, like 01/02/2011

Is there anyway to solve this ?

Big Thanks.
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10May28
[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="Navy"]If[/COLOR] Dn.Offset(, 1).value <> "" [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]If[/COLOR] Q(0) = vbNullString [COLOR="Navy"]Then[/COLOR]
                            Q(0).value = Dn.Offset(, 1)
                        [COLOR="Navy"]Else[/COLOR]
                            Q(0).value = Q(0).value & " - " & Dn.Offset(, 1)
                        [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2).value <> "" [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]If[/COLOR] Q(1) = vbNullString [COLOR="Navy"]Then[/COLOR]
                            [COLOR="Navy"]If[/COLOR] IsDate(Dn.Offset(, 2)) [COLOR="Navy"]Then[/COLOR]
                            Q(1).value = Format(Dn.Offset(, 2), "mmm-yy")
                            [COLOR="Navy"]Else[/COLOR]
                            Q(1).value = Format(Dn.Offset(, 2), "@")
                            [COLOR="Navy"]End[/COLOR] If
                        [COLOR="Navy"]Else[/COLOR]
                            [COLOR="Navy"]If[/COLOR] IsDate(Dn.Offset(, 2)) [COLOR="Navy"]Then[/COLOR]
                            Q(1).value = Format(Q(1).value, "mmm_yy") & " - " & Format(Dn.Offset(, 2), "mmm-yy")
                           [COLOR="Navy"]Else[/COLOR]
                            Q(1).value = Format(Q(1).value, "@") & " - " & Format(Dn.Offset(, 2), "@")
                            [COLOR="Navy"]End[/COLOR] If
                        [COLOR="Navy"]End[/COLOR] If
                  [COLOR="Navy"]End[/COLOR] If
                .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
    Sheets("Total").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 first point works perfect.

On the second point, I made a wrong explanation. I am really sorry!

I precisely don't want it to be in DATE format! I want to avoid it. That's what I meant. It has to be always a string or a number (what was it in origin) and not into date. The problem with the previous code was that if excel detected a 1-2- or something, it automatically turned it into a DATE. Now with the last code you do it with the code. But in reality I don't want a DATE there!

Is it possible to fix it ?

J.
 
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG10May00
[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="Navy"]If[/COLOR] Dn.Offset(, 1).value <> "" [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]If[/COLOR] Q(0) = vbNullString [COLOR="Navy"]Then[/COLOR]
                            Q(0).value = Dn.Offset(, 1)
                        [COLOR="Navy"]Else[/COLOR]
                            Q(0).value = Q(0).value & " - " & Dn.Offset(, 1)
                        [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2).value <> "" [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]If[/COLOR] Q(1) = vbNullString [COLOR="Navy"]Then[/COLOR]
                            Q(1).value = Format(Dn.Offset(, 2), "@")
                        [COLOR="Navy"]Else[/COLOR]
                            Q(1).value = Format(Q(1).value, "@") & " - " & Format(Dn.Offset(, 2), "@")
                        [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]End[/COLOR] If
                .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
    Sheets("Total").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
Sorry Mick it's not working.

For instance, if there's two rows with value "2" and "2" in colC, the merged column has the value "02-Feb" (or 02/02/2011).

Maybe it's because the column is defined as date ? I don't know.
 
Upvote 0
You coukld try fomatting the column as "Text" or any thing other than "Date", though it did not seem to make a difference with me.
This iis My Trial data before, and below the After Result.
Can you supply me with some similar data that does not work. for you.
Code: 
[COLOR=royalblue][B]Row No [/B][/COLOR][COLOR=royalblue][B]Col(A)            [/B][/COLOR] [COLOR=royalblue][B]Col(B)            [/B][/COLOR] [COLOR=royalblue][B]Col(C) [/B][/COLOR]
1.      Header             Header             Header 
2.      [EMAIL="john@provider.com"]john@provider.com[/EMAIL]  UK                 Oct07  
3.      [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                             
4.      [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                             
5.      [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]   France             Feb11  
6.      [EMAIL="eric@fusemail.net"]eric@fusemail.net[/EMAIL]  Added from Norway  Nov93  
7.      [EMAIL="john@provider.com"]john@provider.com[/EMAIL]  United Kingdom     Oct03  
8.      [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]   Paris              Feb93  
9.      [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                             
10.     [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                      Feb94  
11.     [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                             
12.     [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                      1      
13.     [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                      2      
14.     [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                      2      
15.     [EMAIL="john@provider.com"]john@provider.com[/EMAIL]  Greece                    
16.     [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]   Spain              5      
17.     [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]                      Feb98  
18.     [EMAIL="john@provider.com"]john@provider.com[/EMAIL]  France             12

Code: 
[COLOR="RoyalBlue"][B]Row No [/B][/COLOR] [COLOR="RoyalBlue"][B]Col(A)            [/B][/COLOR] [COLOR="RoyalBlue"][B]Col(B)                                [/B][/COLOR] [COLOR="RoyalBlue"][B]Col(C)                                        [/B][/COLOR]
1.      Header             Header                                 Header                                        
2.      [EMAIL="john@provider.com"]john@provider.com[/EMAIL]  UK - United Kingdom - Greece - France  Oct07 - Oct03 - 12                            
3.      [EMAIL="doe@hotmail.name"]doe@hotmail.name[/EMAIL]   France - Paris - Spain                 Feb11 - Feb93 - Feb94 - 1 - 2 - 2 - 5 - Feb98 
4.      [EMAIL="eric@fusemail.net"]eric@fusemail.net[/EMAIL]  Added from Norway                      Nov93
Regards Mick
 
Last edited:
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
280
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,616
Messages
6,179,909
Members
452,949
Latest member
beartooth91

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