PDA

View Full Version : Different Phone Number Formats from list of numbers



Mark K
05-01-2018, 12:42 PM
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
05-01-2018, 02:09 PM
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
05-02-2018, 06:19 AM
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