View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.worksheet.functions
Jacob Skaria Jacob Skaria is offline
external usenet poster
 
Posts: 8,520
Default Extract multiple numbers from a cell

If you have (line break) issues with the previous code ; try the below version

Function ExtractNumbers(strData As String) As String
Dim intTemp As Integer, strChr As String
For intTemp = 1 To Len(strData)
strChr = Asc(Mid(strData, intTemp, 1))
Select Case strChr
Case 48 To 57
ExtractNumbers = ExtractNumbers & Mid(strData, intTemp, 1)
Case 47, 59
If ExtractNumbers < "" Then
If Right(ExtractNumbers, 1) < ";" And Right(ExtractNumbers, 1) _
< "/" Then ExtractNumbers = ExtractNumbers & ";"
End If
End Select
Next
If Not IsNumeric(Right(ExtractNumbers, 1)) Then
ExtractNumbers = Left(ExtractNumbers, Len(ExtractNumbers) - 1)
End If
End Function


--
Jacob (MVP - Excel)


"Jacob Skaria" wrote:

Try this UDF (User Defined function). From workbook launch VBE using Alt+F11.
From menu Insert a Module and paste the below function.Close and get back to
workbook and try the below formula.

=ExtractNumbers(A1)

Function ExtractNumbers(strData As String) As String
Dim intTemp As Integer, strChr As String
For intTemp = 1 To Len(strData)
strChr = Asc(Mid(strData, intTemp, 1))
Select Case strChr
Case 48 To 57
ExtractNumbers = ExtractNumbers & Mid(strData, intTemp, 1)
Case 47, 59
If ExtractNumbers < "" Then
If Right(ExtractNumbers, 1) < ";" And Right(ExtractNumbers, 1) < "/"
Then
ExtractNumbers = ExtractNumbers & ";"
End If
End If
End Select
Next
If Not IsNumeric(Right(ExtractNumbers, 1)) Then
ExtractNumbers = Left(ExtractNumbers, Len(ExtractNumbers) - 1)
End If
End Function

--
Jacob (MVP - Excel)


"Pomona" wrote:

Here are some examples of text with multiple numbers embedded:
A1 = 3031 // 2841;1886-ring road location
A2 = 3305 //1455-historical
A3 = //3491;3492
A4 = //inactive location; historical = 1790; enter new locaion

Result should be:
B1 = 3031;2841;1886
B2 = 3305;1455
B3 = 3491;3492
B4 = 1790