Macro to check against Columns & Delete Duplicates

cjamps · #1 11-23-2017, 08:14 AM

I have an excel spreadsheet that has 4 columns of phone number. The first 3 are Home Phone, Cell Phone, Other Phone. The 4th column are phone numbers from a phone hotline of people that called in. I want to check the 4th column (numbers of people who had called in to the hotline) against the other 3 columns for duplicates. If the phone number already exists in the first 3 columns, the number in the 4th column (ONLY) should be deleted. The phone number format for the first 3 columns are (999) 999-9999. The phone number format for the 4th column is 999-999-9999.

Someone was nice enough to send me this macro quite awhile ago, (I don't remember who to thank them) but it doesn't seem to be working. It is not erasing the duplicates. Can anyone please advise?

Code:

Sub ClearDupesInC() 'cjamps
Dim LastC As Long, LastB As Long, i As Long, j As Long, n As Long

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

For n = 3 To 4

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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA: Delete duplicates in each row	bandaanders	Excel Programming	2	09-02-2015 08:15 AM
Excel vba to check to check if two columns are empty	subspace3	Excel Programming	5	07-09-2015 04:45 PM
Macro to keep first instance and remove duplicates in certain column	zhead	Excel	2	03-18-2015 10:16 AM
find and delete duplicates	rcVBA	Word VBA	4	05-15-2013 03:08 PM
Deleting Duplicates in Macro	jillapass	Excel Programming	1	01-11-2012 10:02 AM