Remove eveything (including text) to the right. What's wrong with this code?

[DaveT]

Yes ....and No. I tested (briefly) just looking for "x" and it seemed to work OK for Ext, Ex, or X because the code then starts looking for a sequence of numbers following the occurrence of "x". If it finds a number, then it extracts every following number until it finds a non-numeric character. Then it stops.

Anyway, I will look at the code and change the logic to extract an extension when it finds ANY single text character (A-Z). THis would assume that any character, a-z, that occurs will be followed by an extension. It would not be triggered by parens () or dashes or slashes, etc: only a-z.

It would be helpful to know what cases we are dealing with.

QUESTION: Do you have the case of Ext 111 (972) 555-5555? That is, the extension occurs before the number.

OR, is it the rule that entensions may, or may not, be present, and if present, the extension will occur after the main number?



In other words to write an extraction routine we have to know the patterns we are dealing with.

[DetrieZ]

Hey Dave!

extract an extension when it finds ANY single text character (A-Z). THis would assume that any character, a-z, that occurs will be followed by an extension. It would not be triggered by parens () or dashes or slashes, etc: only a-z.

A-Z. a-z is exactly right... special characters should not trigger.

The rule is in fact .... that extensions may, or may not, be present, and if present, the extension will occur after the main number?

[DaveT]

OK, try this.

<code>
Public Function ExtractNumeric(TextString As String, EP As String) As String
'version 1.1 DLT
'pass string such as 999-555-1111 Ext 123 (with or without Ext present)
'pass "E" or "P"
'if E then return extension: 123
'if P then return phone: 9995551111

Dim a
Dim x As Long
Dim sDigit As String
Const ABC As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Dim strNumber As String
Dim strExt As String
Dim zPos As Long
Dim zLEN As Long
Dim zMAX As Long
Dim blnFound As Boolean

ExtractNumeric = vbNullString

zLEN = Len(Nz(TextString))

If zLEN = 0 Then
Exit Function
End If

'if we find any character in ABC then
'we will try to extract an extension
'as being the next series of numbers found
zPos = 0

For x = 1 To zLEN
a = Mid(TextString, x, 1)

If InStr(ABC, a) > 0 Then
zPos = x
Exit For
End If

Next

Select Case EP
Case "E"

If (zPos > 0) And (zPos < zLEN) Then
blnFound = False

For x = zPos To zLEN
sDigit = Mid(TextString, x, 1)

If IsNumeric(sDigit) Then

blnFound = True
ExtractNumeric = ExtractNumeric & sDigit

ElseIf (blnFound) And Not IsNumeric(sDigit) Then
Exit Function

End If
Next
End If

Case "P"

If zPos > 0 Then
zMAX = zPos
Else
zMAX = zLEN
End If

For x = 1 To zMAX
sDigit = Mid(TextString, x, 1)

If IsNumeric(sDigit) Then
ExtractNumeric = ExtractNumeric & sDigit
End If
Next
End Select
End Function
</code>

[DaveT]

One final tweak:
......
'version 1.1a DLT
....
Dim blnFound As Boolean
On Error Resume Next 'no harm, no foul
ExtractNumeric = vbNullString

[DetrieZ]

Dave... That did it.. Everything Tested OK...

I was trying to work thru the Const abc.. but couldn't get there.

Thank you sincerely for staying with me on this.

Try to enjoy your weekend

Detrie

[RuralGuy]

Great work people. Is this thread ready to be marked as Solved?