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

[greegan]

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

 

[mirabeau]

I take it Jim, that you didn't try it on 22,000 rows, or even 5000.

Sorting if wanted, and it may not be wanted, is very quick and easy.

 

[Jim885]

mirabeau,

I only tried the codes on 100 rows when I tested them. I didn't think of trying it on 5000 rows until you mentioned it ... Wow! What a difference.

Yours did it in less than a second, while Brian's took about 8 seconds.

 

[BrianMH]

Brian,
I like this code too. Very nice job. Plus, it sorts the columns. Seems to me this should also satisify the greegan's needs.

I noticed that it does not delete duplicates within Column A (which may be what greegan wants).
Just like mirabeau's code, this does Steps 3, 4 and 5 in one operation.

Yeah we can easily add removing duplicates from column A but the OP said he didn't want to remove from A. My code could be sped up by turning off screen updating but I'm not sure how much.

 

[greegan]

Good morning,
Thank you everyone for your help.
Brian, your "removeduplicatenumbers", appears to work the very nicely with what am wanting.
I failed to mention when I paste columns C, E, and G into the main file (with column A already occupied) I would place the data near the bottom of column A, and then I've added a filter with headers for columns C thru G (D and F have "tmp" as headers to link the headers and filters). As a result, my columns would completely clear out rather than what I was wanting it to do.
After testing a few scenarios with the data, I realized I should move it to the top. Once I did this, your code worked as needed.
Thank you.
If I wanted to keep the headers, (Filtering doesn't matter any more, sorting won't make a difference to the final data) what do I need to do?

-- g

 

[BrianMH]

This should ignore the headers.

Sub removeduplicatenumbers()
    Dim r As Range, rCompare As Range, rClear As Range
    Dim x As Integer
    Dim c As Range
    Dim cols1
    Dim i As Integer
    For i = 0 To 2
        cols1 = Array("A", "C", "E", "G")
        Set r = Range(cols1(i) & ActiveSheet.Rows.Count).End(xlUp)
        Set r = Range(cols1(i) & "2", r)
        If rCompare Is Nothing Then
            Set rCompare = r
        Else
            Set rCompare = Union(rCompare, r)
        End If
        Set rClear = Range(cols1(i + 1) & ActiveSheet.Rows.Count).End(xlUp)
        Set rClear = Range(cols1(i + 1) & "2", rClear)
        For x = 1 To rCompare.Areas.Count
            For Each c In rClear
                If WorksheetFunction.CountIf(rCompare.Areas(x), c) > 0 Then
                    c.Clear
                End If
            Next
        Next
        For Each c In rClear
            If WorksheetFunction.CountIf(rClear, c) > 1 Then
                c.Clear
            End If
        Next
        rClear.Sort rClear, xlAscending
    Next








End Sub

 

[greegan]

Thank you! this is working perfectly now.
My next step to remove duplicates is very similar but I'm only comparing two columns. I would expect to change the Array accordingly.
However in this step, headers are on row 4.
I'm not sure what needs to be changed here.

-- g

 

[BrianMH]

Set r = Range(cols1(i) & "2", r)
Set rClear = Range(cols1(i + 1) & "2", rClear)

These two lines are what define the top row. If you change the 2 to 4 it will work from that down.

If you need to keep it as 2 for some columns but 4 for others you could use a select case statement to define the row number.

Assuming you wanted to add 2 more columns and still compare them to the rest but just change the start row you could do this.

Sub removeduplicatenumbers()
    Dim r As Range, rCompare As Range, rClear As Range
    Dim x As Integer
    Dim c As Range
    Dim cols1
    Dim iRow As Integer
    Dim i As Integer
    cols1 = Array("A", "C", "E", "G", "I", "K")
    For i = LBound(cols1) To UBound(cols1)


        Select Case (cols1(i))
            Case "A", "C", "E", "G"
                iRow = 2
            Case "I", "K"
                iRow = 4
        End Select


        Set r = Range(cols1(i) & ActiveSheet.Rows.Count).End(xlUp)
        Set r = Range(cols1(i) & "2", r)
        If rCompare Is Nothing Then
            Set rCompare = r
        Else
            Set rCompare = Union(rCompare, r)
        End If
        Set rClear = Range(cols1(i + 1) & ActiveSheet.Rows.Count).End(xlUp)
        Set rClear = Range(cols1(i + 1) & "2", rClear)
        For x = 1 To rCompare.Areas.Count
            For Each c In rClear
                If WorksheetFunction.CountIf(rCompare.Areas(x), c) > 0 Then
                    c.Clear
                End If
            Next
        Next
        For Each c In rClear
            If WorksheetFunction.CountIf(rClear, c) > 1 Then
                c.Clear
            End If
        Next
        rClear.Sort rClear, xlAscending
    Next


End Sub

 

[greegan]

Good morning,
I actually am wanting to reduce the number of columns. Instead of Column A, its going to be Column B.
Instead of C it will be N.
That would be one "scrubbing", then
It would be repeated for Column P instead of N (B remaining).
Repeats again and again for columns R and T.

I also have to repeat this on another sheet for B with columns N, P, R, T, V, X, Z, and AB
All of these similar to above (B being the originating column, then cleaning columns N thru AB as stated here.

-- g

 

[greegan]

This is an example of my change to the code with your changes and the columns I need to work with.
It looks like it works until I get a Run time error 9: Subscript out of range, highlighting

        Set rClear = Range(cols1(i + 1) & ActiveSheet.Rows.Count).End(xlUp)

Sub removeduplicates_CMS2CD()
    Dim r As Range, rCompare As Range, rClear As Range
    Dim x As Integer
    Dim c As Range
    Dim cols1
    Dim i As Integer
    For i = 0 To 2
        cols1 = Array("B", "N")
        Set r = Range(cols1(i) & ActiveSheet.Rows.Count).End(xlUp)
        Set r = Range(cols1(i) & "4", r)
        If rCompare Is Nothing Then
            Set rCompare = r
        Else
            Set rCompare = Union(rCompare, r)
        End If
        Set rClear = Range(cols1(i + 1) & ActiveSheet.Rows.Count).End(xlUp)
        Set rClear = Range(cols1(i + 1) & "4", rClear)
        For x = 1 To rCompare.Areas.Count
            For Each c In rClear
                If WorksheetFunction.CountIf(rCompare.Areas(x), c) > 0 Then
                    c.Clear
                End If
            Next
        Next
        For Each c In rClear
            If WorksheetFunction.CountIf(rClear, c) > 1 Then
                c.Clear
            End If
        Next
        rClear.Sort rClear, xlAscending
    Next
End Sub

 

[BrianMH]

In my code the first column listed in the array is the column it will use as the initial search and all the rest will be cleaned. Just change put the columns you want in the array and you should be set. Then change the select case as necessary (or remove it and just set the variable irow to the one you want. This will run on whatever sheet you put the code into or if you put the code into thisworkbook module it will run on the active sheet.