Find duplicates numbers in selected columns but delete duplicates in one of those columns

greegan

Well-known Member
Joined
Nov 18, 2009
Messages
643
Office Version
  1. 365
Platform
  1. Windows
Good morning,

I would like to do this with vba
I have column A listing phone numbers, I paste new list of phone numbers in columns C, E, and G.
I would like to find duplicates in columns A and C, and delete cells in column C, then
find duplicates in columns A, C, and E, removing cells only in column E, then
find duplicates in columns A, C, E and G, removing cells only from column G.

Could someone help me with this?

The way I do it now is cumbersome...
In the first step, I would conditional format the duplicates, sort column C by cell colour and delete these cells. With none of this automated.
I'm hoping someone could help out.

Thank you

-- g
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
Can you explain what the problem that you are trying to solve is? There may be a better way of doing this than the way you are describing.

As I understand it you are trying to get rid of duplicates and possibly get rid of some numbers that don't appear in a list also. If you describe the problem you are trying to solve instead of the method you are trying to solve it with we may be able to give better help.
 
Upvote 0
Thank for the reply.


I have column A with 1000's of phone numbers. We want to check it again numbers we get on a daily basis. We put these in column C.
I want to remove the duplicate numbers of both columns FROM column C only.
I'm trying to use conditional formatting for both unique and duplicate cells. I then want to use autofilter, but this is where the range is a problem because every day there is a different count of cells in column C.
What do you recommend?
-- g
 
Upvote 0
does this work for you?
Code:
Sub zuke()

Dim d As Object, a, u(), e
Dim c As Long, j As Long
Set d = CreateObject("scripting.dictionary")

For j = 1 To 7 Step 2
ReDim u(1 To 10 ^ 6, 1 To 1)
    Set a = Cells(j).Resize(Cells(Rows.Count, j).End(xlUp).Row)
    For Each e In a.Value
        If Not d(e) = 1 Then
            d(e) = 1
            c = c + 1
            u(c, 1) = e
        End If
    Next e
    a.ClearContents
    a.Value = u
    c = 0
Next j

End Sub
 
Upvote 0
This should work also.

Code:
Sub removeduplicatenumbers()
Dim rCompare As Range, rClear As Range
Dim c As Range
Set rCompare = Range("A" & ActiveSheet.Rows.Count).End(xlUp)
Set rCompare = Range("A1", rCompare)
Set rClear = Range("C" & ActiveSheet.Rows.Count).End(xlUp)
Set rClear = Range("C1", rClear)
For Each c In rClear
    If WorksheetFunction.CountIf(rCompare, c) > 0 Then
        c.Clear
    End If
Next
rClear.Sort rClear, xlAscending
rClear.RemoveDuplicates


End Sub
 
Upvote 0
Thank you. Both of you. I will respond later today with the results.
 
Upvote 0
It doesn't seem to be working with either of them. Its strange. With my work computer its actually clearing (both scripts) out the unique AND the duplicate numbers.
At home there's no change with "removeduplicate" and it bugs out with "zuke".
Run Time 13, Type mismatch.
Highlighting... "For Each e In a.Value"
 
Upvote 0
...
At home ... it bugs out with "zuke".
Run Time 13, Type mismatch.
Highlighting... "For Each e In a.Value"
The code (zuke) only looks at data in columns A, C, E and G since I understand these are the only ones you want to consider.

Type mismatch error can occur if there's only one, or none, elements in any of these columns.

To remedy that error, try including the modification in red
Rich (BB code):
Sub zuke()

Dim d As Object, a, u(), e
Dim c As Long, j As Long
Set d = CreateObject("scripting.dictionary")

For j = 1 To 7 Step 2
ReDim u(1 To 10 ^ 6, 1 To 1)
    Set a = Cells(j).Resize(Cells(Rows.Count, j).End(xlUp).Row + 1)
    For Each e In a.Value
        If Not d(e) Then
            d(e) = True
            c = c + 1
            u(c, 1) = e
        End If
    Next e
    a.ClearContents
    a.Value = u
    c = 0
Next j

End Sub
 
Upvote 0

Forum statistics

Threads
1,213,532
Messages
6,114,176
Members
448,554
Latest member
Gleisner2

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