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
|