Sub cjamps_B()
Dim i As Long, c As Range, rng As Range
Application.ScreenUpdating = False
    Set rng = Range("A2:D" & Cells(Rows.Count, "D").End(xlUp).Row)    '<----- Range with ALL phone numbers
    rng.Value = Application.Trim(rng)    '<---- Trims a range instead of looping cells
    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
    ActiveSheet.UsedRange.Columns("E:F").Offset(1).ClearContents
Application.ScreenUpdating = True
End Sub