Different Phone Number Formats from list of numbers

[Mark K]

Hello!

First time 'poster', long-time lurker/searcher. For a beginner in VBA, I think I have a pretty lofty goal.

I have searched for the better part of two days in an attempt to locate vba that I can piece together to accomplish my goal but I have not had any luck.

I would like any cell in 'A' with a string length less than 10 (ie: a valid phone number) to have the row deleted and the remaining rows shifted up.

Column B: I would like to have a '1' placed in front of the remaining numbers that don't have a '1' and placed in column B.

Column C: I would like to have the area code placed in paren's and placed in column C with displayed formatting (removing the prefix '1' if present).

Column D: Valid phone numbers with the prefix '1' removed and placed in 'D'.


I hate having to ask someone to essentially 'do the work', but I'm so new to this that I don't know where to start. Thanks for any help!!

Sample file is attached.

[JKwan]

give this a try.
Also, you need to remove your Formatting of your cells, set them back to General.

Option Explicit
Sub Main()
    Dim WS As Worksheet
    Dim LastRow As Long
    Dim lRow As Long
    Dim PhoneNumber As String
    
    Set WS = ThisWorkbook.Worksheets("WorkingCopy")
    LastRow = FindLastRow(WS, "A")
    
    For lRow = LastRow To 2 Step -1
        With WS
            PhoneNumber = .Cells(lRow, "A")
            If Len(PhoneNumber) < 10 Then
                .Rows(lRow & ":" & lRow).Delete
            Else
                If Left(PhoneNumber, 1) <> 1 Then
                    .Cells(lRow, "B") = "1" & PhoneNumber
                Else
                    .Cells(lRow, "B") = PhoneNumber
                End If
                
                Select Case Left(PhoneNumber, 1)
                    Case Is = 1
                        .Cells(lRow, "C") = "(" & Mid(PhoneNumber, 2, 3) & ")" & Mid(PhoneNumber, 5, 10)
                        .Cells(lRow, "D") = Mid(PhoneNumber, 2, 10)
                    
                    Case Else
                        .Cells(lRow, "C") = "(" & Left(PhoneNumber, 3) & ")" & Mid(PhoneNumber, 3, 10)
                        .Cells(lRow, "D") = PhoneNumber
                                            
                End Select
            End If
        End With
    Next lRow
    Set WS = Nothing
End Sub
Function FindLastRow(ByVal WS As Worksheet, ColumnLetter As String) As Long
    FindLastRow = WS.Range(ColumnLetter & Rows.Count).End(xlUp).Row
End Function

[Mark K]

JKwan,

Thank You! I had to make some small mods for hyphening & digit duplication but it works GREAT! Thank you also for the quick response!

Mark