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

 

[greegan]

mirabeau,
your code is now clearing all data in C, E, and G.
You are correct, these are the columns I would like the duplicate data remove from.
What could be causing them to disappear?
Thank you again for the assist
-- g

 

[greegan]

mirabeau,
I'm not sure why but it is still clearing all data in the selected columns C, E, and G.
Thank you for your assistance.

-- g

 

[BrianMH]

I've tested this and it works. If it doesn't work for you please provide a sample of the data before you manually remove duplicates and then after.

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) & "1", 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) & "1", 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

 

[mirabeau]

mirabeau,
I'm not sure why but it is still clearing all data in the selected columns C, E, and G.
Thank you for your assistance.

-- g

greegan,

Before posting it, I checked the code zuke against test data as generated by the code below.

What zuke does is remove any duplicates from ColA (that bit's easily skipped if you like), then removes any values in ColC that occur in A, then removes any values in E that occur in C, etc.

The final result is that there's no duplicates left in the four columns, either within columns or between them. I took it that was what you wanted. If it's not, could you please re-explain what you want to achieve.

If any column is completely cleared then all of its values have already occurred in previous columns.

You may like to run the testdata code on a blank worksheet, then test the duplicate-removing codes. You can change the value s in the test datacode to 5000 or 22000 or whatever makes the dataset size more realistic.

Sub testata()

s = 10    'change to whatever you like
For j = 1 To 7 Step 2
With Cells(j).Resize(Int(Rnd * 4) + s)
    .Cells = "=randbetween(1," & 2 * s & ")"
    .Value = .Value
End With
Next j

End Sub

 

[greegan]

Step 1 will be to generate column A numbers.
This is automatic.
Step 2 would be to paste my three columns into the worksheet
Step 3 is to find duplicates in column C that also occur in Column A. Remove only duplicate data in Column C.
Step 4 is to find duplicates in Column E and compare this to Columns C and A, only removing the duplicate number in Column E.
Step 5 is the find the duplicates in Column G and compare these to columns E, C, and A. Only removing duplicates from column G.

I've tried filtering but if there are no duplicates present, it messes up.

I should have provided a more specific description of what I am trying to do. I'm thinking I didn't really know how it would need to be done.

Does this help make things clearer?

Thank you, both of you, for your time and assistance.

-- g

 

[mirabeau]

Step 1 will be to generate column A numbers.
This is automatic.
Step 2 would be to paste my three columns into the worksheet
Step 3 is to find duplicates in column C that also occur in Column A. Remove only duplicate data in Column C.
Step 4 is to find duplicates in Column E and compare this to Columns C and A, only removing the duplicate number in Column E.
Step 5 is the find the duplicates in Column G and compare these to columns E, C, and A. Only removing duplicates from column G.

I've tried filtering but if there are no duplicates present, it messes up.

I should have provided a more specific description of what I am trying to do. I'm thinking I didn't really know how it would need to be done.

Does this help make things clearer?

Thank you, both of you, for your time and assistance.

-- g

greegan,

post #14 gives a testdata code that generates data which as far as I can see fits your description of your data setup.

so, is your data setup different from this. if so, how does it differ?

 

[Jim885]

mirabeau,
I like this bit of code.

Sub testata()

s = 10    'change to whatever you like
For j = 1 To 7 Step 2
With Cells(j).Resize(Int(Rnd * 4) + s)
    .Cells = "=randbetween(1," & 2 * s & ")"
    .Value = .Value
End With
Next j

End Sub

Rather than start a new topic about this code, I have a simple request for you. If you don't mind, could you modify it so that it puts random data on the second row (beginning at A2)? Whereby, I could maintain the column headers when the code runs. Thanks for any help you can provide.

PS
Your "zuke" code works perfectly for me, and seems to operate just as the OP has requested.

 

[mirabeau]

@Jim

With Cells(2, j).Resize(Int(Rnd * 4) + s)

the code zuke worked good for me too.

but seems my interpretation of greegan's data setup is somehow astray.

 

[Jim885]

@Jim

With Cells(2, j).Resize(Int(Rnd * 4) + s)

the code zuke worked good for me too.

but seems my interpretation of greegan's data setup is somehow astray.

Thanks for the modification.
I worked out this;

s = 20
For j = 1 To 7 Step 2
With Range("A2:G" & s).Resize(Int(Rnd * 1) + s)   
    .Cells = "=RandBetween(10," & 2 * s & ")" 
    .Value = .Value
End With
Next j

But I like your mod better. Thanks !

It also seems my interpretation of greegan's setup is somehow astray, because I interperat it the same as you.

 

[Jim885]

I've tested this and it works. If it doesn't work for you please provide a sample of the data before you manually remove duplicates and then after.

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) & "1", 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) & "1", 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

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.