Deleting Duplicates of Second Instance

Deleting Duplicates of Second Instance

Home Phone Mobile Phone Ad Response
(999) 999-9999 999-999-9999
(999) 999-9999 999-999-9999
(999) 999-9999 999-999-9999
(999) 999-9999 999-999-9999
(999) 999-9999 999-999-9999
(999) 999-9999 999-999-9999
(999) 999-9999 999-999-9999
(999) 999-9999 (999) 999-9999 999-999-9999
(999) 999-9999 (999) 999-9999 999-999-9999
999) 999-9999 (999) 999-9999 999-999-9999


I organize lectures and I advertise a hotline. Column A and Column B are in my outlook contacts. Column C is a response to an ad or called the hotline. If there are duplicates I want to delete the duplicate that is in column C. Notice that column C is a different format then Column A or Column B.

I did this manually through the find all feature in excel. It was beautiful but very tedious. I would love to have an option to make it more automatic. Would anybody please point me in the right direction.

Thanx so much.

Sourabhg98 is right, it's hard to tell exactly what you're after. The procedure below works for me, based upon what I think you want. If the number in C matches any number in A or B, the C value will be deleted. It isn't clear from your post if the duplicate occurrences will always fall in the same row, so my procedure sweeps through all rows for each number in column C. This is the less efficient path, but it should still cover everything.

Sub ClearDupesInC()
Dim LastC As Long
Dim LastB As Long
Dim i As Long
Dim j As Long


Application.ScreenUpdating = False
LastC = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
LastB = ActiveSheet.UsedRange.Rows.Count

For i = LastC To 2 Step -1       'if you have no header, go from LastC to 1
    If Cells(i, 3).Value <> "" Then
    For j = LastB To 2 Step -1   'if you have no header, go from LastB to 1
        If (Right(Cells(i, 3).Value, 8) = Right(Cells(j, 2).Value, 8) And InStr(2, Left(Cells(j, 2).Value, 4), Left(Cells(i, 3).Value, 3))) _
        Or (Right(Cells(i, 3).Value, 8) = Right(Cells(j, 1).Value, 8) And InStr(2, Left(Cells(j, 1).Value, 4), Left(Cells(i, 3).Value, 3))) Then
            Cells(i, 3).ClearContents
        End If
    Next j
    End If
Next i
Application.ScreenUpdating = True
End Sub

Hi. This is my first time so please excuse my questions. I am still trying to understand how to attach and upload files here. The original file that I tried uploading is:

delete duplicates.jpg (I had no idea you were supposed to press upload so I kept exiting) I tried the paper clip but it just gives me a blank box. I don't know what to put in it.

I do a mass phone blast when I have to publicize a lecture that I am organizing. I have 3 columns. The first 2 columns (Column A and Column B) are exported from my contacts in outlook. It is their home phone and mobile phone. If they don't have a home phone or a cell phone, the cell is blank. I need these columns to stay as is.

It is the 3rd column (Column C) that I need to be edited because I add these numbers to the phone blast. These are the phone numbers of the people who call into the hotline. Some of them are members who are already in the contact list and some of them are not. Therefore I need the duplicates (the ones already in the outlook contacts) to be deleted from Column C only. Please note also that column C is in a different format because I copy and paste the called phone numbers straight from the hotline system's email into excel.

I have tried to run the macro but received an error as you will see here: (I hope)

compile error.jpg

Please advise.

It looks like when you pasted my code into your window, it combined two lines into one. The line that's giving you the error should be two lines.

Wrong:
LastC = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row LastB = ActiveSheet.UsedRange.Rows.Count


Right:
LastC = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
LastB = ActiveSheet.UsedRange.Rows.Count

Try fixing that and let me know if it works...

Yes, you are right. I corrected it.

But now that I am running it, I don't see anything happening. The duplicates are still there.

What am I doing wrong.

Nothing at all is happening to the duplicates in C? It works on my efforts to mimic your data. Can you post a sample workbook?

I don't have a sample, only the real thing. I am hesitant to post it as it could be seen by search engines. Is there another way I could send it, perhaps by email. cjamps@gmail.com

Thanx

Not a sample of the real thing, but an actual excel workbook with data/format that mimics the real thing. Above you've posted screenshots with number consisting entirely of nines. Can you post a workbook with 10 or so rows of more realistic fake numbers? I've attached the sample book I made for myself, on which the code appears to work. I'm trying to figure out why my results are differing from yours...

My previous procedure only searched columns A and B. I didn't realize you wanted to check C against itself. The procedure below should achieve that. I believe it will also remove the "1" at the start of any number in column C. Let me know if it works...

Sub ClearDupesInC()
Dim LastC As Long
Dim LastB As Long
Dim i As Long
Dim j As Long


Application.ScreenUpdating = False
LastC = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Row
LastB = ActiveSheet.UsedRange.Rows.Count

For i = LastC To 2 Step -1       'if you have no header, go from LastC to 1
    If Left(Cells(i, 3).Value, 1) = 1 Then
        Cells(i, 3).Value = Right(Cells(i, 3).Value, Len(Cells(i, 3).Value) - 1)
    End If
    If Cells(i, 3).Value <> "" And Application.WorksheetFunction.CountIf(Range("C2:C" & LastC), Cells(i, 3).Value) > 1 Then
        Cells(i, 3).ClearContents
    End If
    If Cells(i, 3).Value <> "" Then
    For j = LastB To 2 Step -1   'if you have no header, go from LastB to 1
        If (Right(Cells(i, 3).Value, 8) = Right(Cells(j, 2).Value, 8) And InStr(2, Left(Cells(j, 2).Value, 4), Left(Cells(i, 3).Value, 3))) _
        Or (Right(Cells(i, 3).Value, 8) = Right(Cells(j, 1).Value, 8) And InStr(2, Left(Cells(j, 1).Value, 4), Left(Cells(i, 3).Value, 3))) Then
            Cells(i, 3).ClearContents
        End If
    Next j
    End If
Next i

Application.ScreenUpdating = True
End Sub