Microsoft Office Forums - View Single Post - [Solved] Macro to check against Columns & Delete Duplicates

jolivanes · 12-12-2017, 09:12 PM

Another long winded approach that might work.
Try on a copy of your original first.
Columns A, B and C have phone numbers to be compared to.
Column D has the phone numbers without bracketed area codes and a possible 1 in front
Columns E and F are empty and free to use.

Code:

Sub cjamps()
Dim i As Long, c As Range
Application.ScreenUpdating = False
    With Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
        .Offset(, 1).Formula = "=IF(LEN(RC[-1])=13,RIGHT(RC[-1],12),RC[-1])"
        .Offset(, 1).Value = .Offset(, 1).Value
        .Offset(, 2).Formula = "= ""(""&LEFT(RC[-1],3)&"")""&"" ""&MID(RC[-1],5,3)&"" ""&MID(RC[-1],9,4)"
        .Offset(, 2).Value = .Offset(, 2).Value
    End With
    For Each c In Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row)
        For i = 2 To Cells(Rows.Count, "F").End(xlUp).Row
            If WorksheetFunction.CountIf(Range(c.Offset(, -5).Address & ":" & c.Offset(, -3).Address), c.Value) <> 0 Then c.Offset(, -2).ClearContents: Exit For
        Next i
    Next c
    Columns("E:F").ClearContents
Application.ScreenUpdating = True
End Sub