extract non-specific info from multiple cells

i have a vertical list of over 8000 names and phone numbers, the problem is they are all in one cell.. ie

Fund for District Nurses 01793 554200

is it possible for me to apply a process to all these cells that would copy all the telephone numbers out of the original cell and stick them in a new one? all the numbers are different, all the text in the cells are different.

THANKYOU!!!!

rossww wrote:
> i have a vertical list of over 8000 names and phone numbers, the problem
> is they are all in one cell.. ie
>
> Fund for District Nurses 01793 554200
>
> is it possible for me to apply a process to all these cells that would
> copy all the telephone numbers out of the original cell and stick them
> in a new one? all the numbers are different, all the text in the cells
> are different.
>
> THANKYOU!!!!
>
>
> --
> rossww
> ------------------------------------------------------------------------
> rossww's Profile: http://www.excelforum.com/member.php...o&userid=36742
> View this thread: http://www.excelforum.com/showthread...hreadid=564613

Hi,

If all the phonenumbers are at the end of the text in the cell then you
can use something like this:

=MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&{0,1,2,3,4,5,6,7,8,9})),1024)

If your list starts in A1 then put this in B1 and just copy down the
length of your list.

Regards,
Bondi

You could try this. It works on selected cells, so select your cells and then run the macro. It will populate the next righthand cell with the text part and the second right hand cell with the number part.

See how you get on with it.

Sub a()
Dim rng As Range
Dim i As Integer

Dim strRng As String
Dim str As String
Dim strOutAlpha As String
Dim strOutNum As String

Dim j As Integer
Dim IsAlpha As Boolean

For Each rng In Selection
i = 0
j = 0
strRng = rng
strOutAlpha = ""
strOutNum = "'"
IsAlpha = True

For j = 1 To Len(strRng)
str = Mid(strRng, j, 1)
Select Case str
Case "0" To "9"
IsAlpha = False
strOutNum = strOutNum & str
Case " "
If IsAlpha Then
strOutAlpha = strOutAlpha & str
End If
Case Else
IsAlpha = True
strOutAlpha = strOutAlpha & str
End Select
Next
rng.Offset(, 1) = strOutAlpha
rng.Offset(, 2) = strOutNum
Next
MsgBox "done"
End Sub