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
Hi Mick,

This is my example table :

Code: 
Row No    Col(A)                Col(B)              Col(C)
1.            john@aol.com      Text John1                1
2.            doe@gmail.com    Text doe                   4
3.            john@ail.com       Text John2                2
Then your code leaves the sheet like this :

Code: 
Row No    Col(A)                Col(B)                      Col(C)
1.            john@aol.com      Text John1 - Text John2        01-Feb
2.            doe@gmail.com    Text doe                              4
And what is more strange to me, is that if I change the column with :
Format -> Cell -> Number -> Number (0 decimal positions)

Then if I run your code the result is :

Code: 
Row No    Col(A)                Col(B)                      Col(C)
 1.            john@aol.com      Text John1 - Text John2        40575
 2.            doe@gmail.com    Text doe                              4

In reality, ColC almost never have dates, it's just numbers from 1 to 10, I used it as an example at the first post.

If I define the column to "Text", then it works. But I am wondering now why it's not working if defined as number.

I guess the column type can be changed later from Text to Number and viceversa if needed, right ?

Thanks.
J.
 
Last edited:
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Try This:-
Keep your fingers crossed !!!
Code: 
[COLOR=navy]Sub[/COLOR] MG10May05
[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
                    Q(1).NumberFormat = "@"
                    [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 = Dn.Offset(, 2)
                        [COLOR=navy]Else[/COLOR]
                            Q(1).value = Q(1).value & " - " & 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
Mick,

I am willing to clean the spaces of the values of Sheet "Total" Column A, before finding the duplicates, to avoid errors.

I have added this code :

Code: 
Dim myArray As Variant, i As Long
    With ThisWorkbook.Sheets("Total").Range("A:A")
        myArray = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value

        For i = 1 To UBound(myArray, 1)
            myArray(i, 1) = Trim(myArray(i, 1))
        Next i

        Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value = myArray
    End With

But it is not working. It doesn't give an error. Would you please give me a hand ?
 
Upvote 0
Just a couple of dots missing at the beginning of "Range"!!
Rich (BB code): 
Dim myArray As Variant, i As Long
    With ThisWorkbook.Sheets("Total").Range("A:A")
        myArray = .Range(.Cells(1, 1), .Cells(.rows.Count, 1).End(xlUp)).value
        For i = 1 To UBound(myArray, 1)
            myArray(i, 1) = Trim(myArray(i, 1))
        Next i
        .Range(.Cells(1, 1), .Cells(.rows.Count, 1).End(xlUp)).value = myArray
    End With
Mick
 
Upvote 0
Mick,

That worked, thanks! Although I've found that it only removes spaces from beginning and end of the cell, not in between. I want to remove ALL spaces, beginning, end, or inbetween. How would I do that ?

Also, if possible count the number of cells that contained spaces, just to see how badly the ColumnA was formatted.

Thanks again man.
 
Last edited:
Upvote 0
Try this:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG11May27
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] SpNum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & rows.Count).End(xlUp))
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        Temp = Dn
        Dn = Replace(Dn, " ", "")
        SpNum = SpNum + IIf(Temp <> Dn, 1, 0)
[COLOR="Navy"]Next[/COLOR] Dn
MsgBox "Rows with spaces = " & SpNum
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Mick,

It works perfectly. Although I need it to be for specific sheet called "Total". Is it possible ? Thanks.
 
Upvote 0
Try:-
Code: 
[COLOR="Navy"]Sub[/COLOR] MG11May10
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] SpNum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Temp [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
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        Temp = Dn
        Dn = Replace(Dn, " ", "")
        SpNum = SpNum + IIf(Temp <> Dn, 1, 0)
[COLOR="Navy"]Next[/COLOR] Dn
MsgBox "Rows with spaces = " & SpNum
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
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,616
Messages
6,179,908
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