View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Ron Rosenfeld Ron Rosenfeld is offline
external usenet poster
 
Posts: 5,651
Default Stripping characters from strings and writing contents to another

On Sun, 8 Jun 2008 22:33:00 -0700, BatmanFromOz
wrote:

Hi

I am new to Visual Basic, but I have a worksheet with the following text in
one cell of each row. I would like to strip out the first number and place in
another cell to the right, then strip out the second number and place in it's
own cell on the right as well. Repeat the process for each row.

Wk17 to Wk21
Wk17 to Wk21
Wk17 to Wk21
Wk2 to Wk21
Wk17 to Wk21
Wk17 to Wk21

Any ideas? Thanks in advance for your help.

Adam


If you want to leave the original unchanged, and just extract the two numbers,
you can also do it with formulas:

First number:

=LOOKUP(9.9E+307,--MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"
0123456789")),ROW(INDIRECT("1:"&LEN(A1)))))

2nd number (first number after the <space:

=LOOKUP(9.9E+307,--MID(A1,MIN(SEARCH({0,1,2,3,4,5,6,7,8,9},A1&"
0123456789",FIND(" ",A1))),ROW(INDIRECT("1:"&LEN(A1)))))

Another VBA method, written as a macro:

Examine the comments for certain techniques that may be of value.

There are many ways to decide if the data is valid, and/or to set up the range
on which to operate.

====================================
Option Explicit
Sub ExtrNums()
Dim c As Range, rSrc As Range
Dim re As Object, mc As Object

'Expand selection to include Current Region
' so selection could be just one cell
'Then resize to operate only on the leftmost
' column

Set rSrc = Selection.CurrentRegion
Debug.Print rSrc.Address
Set rSrc = rSrc.Resize(, 1)
Debug.Print rSrc.Address

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "\d+"

For Each c In rSrc
'clear the two cells to the right
Range(c(1, 2), c(1, 3)).Clear

Set mc = re.Execute(c.Value)

'make sure there are two numbers in the original source
If mc.Count = 2 Then
c.Offset(0, 1).Value = CDbl(mc(0))
c.Offset(0, 2).Value = CDbl(mc(1))
End If
Next c
End Sub
==========================================
--ron