Unwanted Characters in Phone Numbers

[flip79]

I have a huge file containing phone numbers where all unwanted characters like paranthesis, spaces, periods, and dashes need to be removed. Is there a way to do this in VBA? Right now I am using the functions Left$, Right$, and Mid$ to remove the characters (and place the numbers back together), but any of these characters could be in different places within the phone number string. My If Elseif statement is getting really long...

Any help in greatly appreciated!

Thanks!

 

[vb5prgrmr]

[tt]
Private Sub Form_Load()

'say your phone number is something like this
'Ph#(111)-111-1111 and you want to remove the "-
'", "(", &quot", "#", and the "Ph" so that you have 1111111111 as a result
Dim PhNum As String
PhNum = FormatPhoneNumber("Ph#(111)-111-1111&quot
MsgBox PhNum
End Sub

Public Function FormatPhoneNumber(PhoneNumber As String) As String

Dim I As Integer, Char As String

PhoneNumber = Replace(PhoneNumber, "-", "&quot 'PhoneNumber = Ph#(111)1111111
PhoneNumber = Replace(PhoneNumber, "(", "&quot 'PhoneNumber = Ph#111)1111111
PhoneNumber = Replace(PhoneNumber, &quot", "&quot 'PhoneNumber = Ph#1111111111

For I = 1 To Len(PhoneNumber)

Char = Mid(PhoneNumber, I, 1)
Select Case Char
Case 0 To 9
FormatPhoneNumber = FormatPhoneNumber & Char
End Select

Next I


End Function

 

[Schroeder]

Unfortunately, the Replace function doesn't work in VBA.

What about something like this?

Function FormatPhoneNumber(PhoneNumber As String) As String
Dim K As Integer
Dim strFormatted As String
For K = 1 To Len(PhoneNumber)
If IsNumeric(Mid(PhoneNumber, K, 1)) Then strFormatted = strFormatted & Mid(PhoneNumber, K, 1)
Next
FormatPhoneNumber = strFormatted
End Function

 

[LW]

Here is a function I wrote whe I found Excel didn't support the replace function. After each call to xlReplace, check to see if their are additional nonnumeric chrs in the string. You may also want to look into regular expressions.
Hope this helps.

Public Function XLreplace(ByVal Exp As String, ByVal Find As String, ByVal Replace As String) As String
Dim i As Integer

Exp = Trim(Exp)

Do While InStr(Exp, Find)
i = InStr(Exp, Find)
Exp = Mid(Exp, 1, i - 1) & Replace & Mid(Exp, (i + 1))
Loop
XLreplace = Exp

On Error GoTo 0
End Function

 

[vb5prgrmr]

So how hard is it to create your own simple replace function in VBA???

[tt]
Public Function MyReplace(Expression As String, Find As String, ReplaceWith As String, Optional Start As Long = -1) As String

Dim I As Double

If Start < 0 Then Start = 1

For I = Start To Len(Expression)

If Mid(Expression, I, 1) = Find Then
Expression = Left(Expression, I - 1) & ReplaceWith & Mid(Expression, I + Len(Find))
End If

Next I

MyReplace = Expression

End Function
[/tt]

OR Using my example without replace

[tt]
Public Function FormatPhoneNumber(PhoneNumber As String) As String

Dim I As Integer, Char As String

For I = 1 To Len(PhoneNumber)

Char = Mid(PhoneNumber, I, 1)
Select Case Char
Case 0 To 9
FormatPhoneNumber = FormatPhoneNumber & Char
End Select

Next I


End Function
[/tt]

 

[flip79]

Thanks for all your help! I think I am very close to coming up with a solution.

 

[Schroeder]

vb5prgrmr, &quot;Unfortunately&quot; wasn't sarcasm. I truly find it unfortunate! But you're right, a hand-made replace function is certainly do-able, although I don't think the one you've provided will work properly. In your If statement, you're only checking the one character at position I. That'll work fine if Find is only one character long but if that's the case why do you say &quot;I + Len(Find)&quot; later on? Plus, you need to set your I counter up the length of Replace before Next. What if you're replacing &quot;A&quot; with &quot;AA&quot;? You'll have an infinite loop on your hands.

A long time ago I asked about a Replace function for VBA and somebody posted this

Public Function FindReplace(strOrig As String, strOld As String, strNew As String)

Dim intAt As Integer, strAltered As String

If IsNull(strOrig) Or IsNull(strOld) Or IsNull(strNew) Then
MsgBox &quot;Need String To search, plus Old and New Values&quot;, vbInformation, &quot;Need Additional Info&quot;
Else
For intAt = 1 To Len(strOrig)
If Mid(strOrig, intAt, Len(strOld)) = strOld Then
strAltered = strAltered & strNew
intAt = intAt + (Len(strOld) - 1)
Else
strAltered = strAltered & Mid(strOrig, intAt, 1)
End If
Next intAt
End If
FindReplace = strAltered
End Function

 

[vb5prgrmr]

Schroeder

Not taken that way just trying to show that there is always more than one way to figure out a problem, and your right it was quick and dirty and from memory from one that I wrote in vb5.0 that I used way back when when it came out.

 

[strongm]

And another alternative - particularly useful with large files - might be to add a reference to the Microsoft Regular Expressions library. Then:
[tt]
Public Function CleanPhoneText(strSourceText As String) As String
Dim re As RegExp

Set re = New RegExp
re.Global = True
re.MultiLine = True
re.Pattern = &quot;([^\d\n\r])?&quot;
CleanPhoneText = re.Replace(strSourceText, &quot;&quot
Set re = Nothing
End Function