View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.newusers
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default extract numbers from text string

On Sun, 16 Dec 2007 09:31:03 -0800, thomsonpa
wrote:

I have a column of cells with information in some of the cells only. the
information is text with numbers (the text can be of varying length), for
example: C3 could contain: 1 avml 12 chml 1 special occasion.
There could be as many as 12 variations in the string of text.
I need to extract all the information into other cells, seperating the
numbers from the text so H3 = 1 I3 = avml, etc.
How do I do this with visual basic?


Here's a routine that might work if I understand your pattern correctly.

<alt-F11 opens the VB Editor. Ensure your project is highlighted in the
Project Explorer window, then Insert/Module and paste the code below into the
window that opens.

Be sure to define Dest and Src appropriately in the VBA Code.

Then <alt-F8 opens the macro dialog box. Select the macro and <Run.

The logic is (or should be <g), that the routine views the data as a sequence
of words.

It looks for sub-sequences which consist of a word that consists only of
digits, followed by a sequence of words none of which consist of only digits.

It then splits them.

That should take care of issues such as multiple word descriptors, as you have
with "special occasion", as well as descriptors that might include a digit.

But this should give you a start, and you can post back with how it works.

=================================================
Option Explicit
Sub ParseData()
Dim Src As Range
Dim Dest As Range
Dim c As Range
Dim i As Long, j As Long
Dim re As Object, mc As Object, m As Object
Const sPat As String = "(\d+)\s+(.*?)(?=(\b\d+\b)|$)"

Set Src = Range("A3:a100") 'or wherever your data is
Set Dest = Range("H3:H100") 'your destination range

Dest.ClearContents
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
j = 1
For Each c In Src
If re.test(c.Text) = True Then
Set mc = re.Execute(c.Text)
For i = 0 To mc.Count - 1
Dest(j, i * 2 + 1).Value = mc(i).submatches(0)
Dest(j, i * 2 + 2).Value = mc(i).submatches(1)
Next i
End If
j = j + 1
Next c
End Sub
=============================================
--ron