Spliting Numbers from a Text string

[wutzke]

In my worksheet I have a series of cells containing a text string. I
Would like split the text up into individual cells. The "05" is a
date. "PM" is a time code. Everything between "05" & "PM" is a
complete title.

All the rest after "PM" is seven numbers separrated by a space.

day location
05 BARHRJANS REGULAR1 PM 16.00 16.00 1.00 2.00 0.00 11.83 19.
05 BARHYTRFGHKNS REGULAR2 PM 1.00 1.00 10.00 20.00 0.00 121.83 129.
05 BARHHUNNY44S REGULAR3 PM 110.00 10.00 10.00 2.00 0.00 11.83 119.
05 BARHR887-GUNNS REGULAR4 PM 0.00 0.00 1.00 2.00 0.00 11.83 19.

The date code, "05" and time code "PM" never change in text length.
But the title length and the number vary in length.

=VALUE(MID(RIGHT(A1,LEN(A1)-SEARCH(" PM ",A1)-3),
1,SEARCH(".",RIGHT(A1,LEN(A1)-SEARCH(" PM ",A1)-3)))) will give me
the 1st value of 16 if I use the time code "PM" to search with and
then the decimal point "."

Is there a better way?

 

[JMB]

Are you trying to extract the numbers that appear after " PM " into separate
cells?

You could use
=TRIM(MID(A1,FIND(" PM ",A1)+4,LEN(A1)))
to extract everything to the right of " PM ".

so you would have
16.00 16.00 1.00 2.00 0.00 11.83 19.
all in one cell

Then copy this extracted string of numbers and click edit/paste
special/values to hardcode the string. Then click Data/Text To Columns and
use a space delimiter to separate each number into its own cell (ensure there
is no data in the columns to the right as they could get overwritten).

 

[Rick Rothstein \(MVP - VB\)]

Since you posted your question to the programming newsgroup, are you up for
a VBA macro program solution? Put this code...

Sub GetNumbers()
Dim X As Long
Dim Cell As Range
Dim Parts() As String
For Each Cell In Selection
Parts = Split(Cell.Value)
For X = 1 To 7
Cell.Offset(0, X).Value = Parts(UBound(Parts) + X - 7)
Next
Next
End Sub

in the code window for the sheet where your data is (right-click the sheet's
tab, select View Code from the popup menu and copy/paste the code into the
window that appeared). Then go back to the worksheet and select all of the
cells with your data (it's okay if there are non-data text within the
selection); press Alt+F8, select GetNumber from the dialog box that appears
and click the Run button.

Rick

 

[Rick Rothstein \(MVP - VB\)]

But if you really do want a formula solution instead of a macro one, put
this formula...

=IF($A1="","",MID(SUBSTITUTE($A1,LEFT($A1,1+SEARCH("PM",$A1)),""),1+FIND("|",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE($A1,LEFT($A1,1+SEARCH("PM",$A1)),""),"
","|",COLUMN(A1))&" ","
","||",COLUMN(A1))),FIND("||",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE($A1,LEFT($A1,1+SEARCH("PM",$A1)),""),"
","|",COLUMN(A1))&" ","
","||",COLUMN(A1)))-FIND("|",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE($A1,LEFT($A1,1+SEARCH("PM",$A1)),""),"
","|",COLUMN(A1))&" "," ","||",COLUMN(A1)))))

in the first cell you want the first parsed out number to go in, copy it
across into the next 6 columns and then copy those 7 cells down as far as
you want.

Rick

 

[wutzke]

Thanks for the solution. I was looking for a VB answer, sorry I didn't
mention that.

 

[Rick Rothstein \(MVP - VB\)]

While 'wutzke' has already indicated he was after a VBA solution, I figured
if anyone wanted to use this as a basis for a different application, I would
re-post the formula accounting for newsreader's that break the long string
at blank spaces (making them hard to see). Here is that repost, broken apart
in such a way that blank spaces are preserved...

=IF($A1="","",MID(SUBSTITUTE($A1,LEFT($A1,1+SEARCH("PM",$A1)),""),
1+FIND("|",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE($A1,LEFT($A1,1+SEARCH
("PM",$A1)),"")," ","|",COLUMN(A1))&" "," ","||",COLUMN(A1))),
FIND("||",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE($A1,LEFT($A1,1+SEARCH
("PM",$A1)),"")," ","|",COLUMN(A1))&" "," ","||",COLUMN(A1)))-
FIND("|",SUBSTITUTE(SUBSTITUTE(SUBSTITUTE($A1,LEFT($A1,1+SEARCH
("PM",$A1)),"")," ","|",COLUMN(A1))&" "," ","||",COLUMN(A1)))))

Rick

 

[Bernd P]

Hello,

I suggest to take the UDF regexpreplace:

=regexpreplace(A1,"^05 (.+) PM" & REPT(" (\d*.?\d*)",7) & "$","$1")

(you can call it via VBA with another first parameter - the last
parameter defines the n-th return value. I you use "$4" it would
return 10.00 for your second sample row).

The function you can find here: http://www.sulprobil.com/html/regexp.html

Regards,
Bernd

 

[Ron Rosenfeld]

Hello,

I suggest to take the UDF regexpreplace:

=regexpreplace(A1,"^05 (.+) PM" & REPT(" (\d*.?\d*)",7) & "$","$1")

(you can call it via VBA with another first parameter - the last
parameter defines the n-th return value. I you use "$4" it would
return 10.00 for your second sample row).

The function you can find here: http://www.sulprobil.com/html/regexp.html

Regards,
Bernd

The OP wrote: "The date code, "05" and time code "PM" never change in text
LENGTH."

I think it unlikely that they never change at all. If they do, your regex will
fail.

It will also fail to extract the proper value if any of the values should ever
be negative numbers.

I think Rick's solution, or some variation on it (using the VBA Split
function), is probably the most efficient in VBA.

If I were going to use a regex variation, I would do something like, using the
code below:

A1: Data
B1: =ReExtr($A2,"[-+]?\b\d*\.?\d+\b",-8+COLUMNS($A:A))
(The "8" is one more than the number of numeric entries at the end to be
parsed. This last argument is the Index which, if negative, counts backward
from the last match)

Fill right to H1
Select B1:H1 and fill down as far as required

======================================================
Option Explicit
Function ReExtr(Str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True, _
Optional MultiLin As Boolean = False)

Dim objRegExp As Object, objMatch As Object, colMatches As Object
Set objRegExp = CreateObject("vbscript.regexp")
With objRegExp
.Pattern = Pattern
.IgnoreCase = Not CaseSensitive
.Global = True
.MultiLine = MultiLin
End With

If (objRegExp.Test(Str) = True) Then
Set colMatches = objRegExp.Execute(Str)
ReExtr = CStr(colMatches(IIf(Index > 0, Index - 1, _
colMatches.Count + Index)))
End If
End Function
==============================

--ron

 

[Bernd P]

Hello Ron,

IMHO it is a nice and robust approach to take the UDF regexpreplace as
a "black box" and then to call it (may it be from a worksheet or from
within VBA) with:

=regexpreplace(A1,"^05 (.+) PM" & REPT(" ([-+]?\d*\.?\d*)",7) &
"$","$1")

I have no problem to accept a better fitting regular expression here
but I would not even seek for a most efficient solution in VBA. If
efficiency is an issue (in terms of runtime) I would do the
preprocessing with sed or perl...

Regards,
Bernd

 

[Ron Rosenfeld]

Hello Ron,

IMHO it is a nice and robust approach to take the UDF regexpreplace as
a "black box" and then to call it (may it be from a worksheet or from
within VBA) with:

=regexpreplace(A1,"^05 (.+) PM" & REPT(" ([-+]?\d*\.?\d*)",7) &
"$","$1")

I have no problem to accept a better fitting regular expression here
but I would not even seek for a most efficient solution in VBA. If
efficiency is an issue (in terms of runtime) I would do the
preprocessing with sed or perl...

Regards,
Bernd

Be that as it may, the OP was looking for a VBA solution. Rick's previously
posted solution is quite effective. Both of our regex solutions take about
fifty (50) times as long to extract the first number after the PM.

Longre's Regex.Mid function, part of the morefunc.xll add-in, runs about twice
as fast as either of ours.

I see you've adapted yours to include both positive and negative numbers, but
it still will work only with date code of 05 and time code of PM.

I agree the Regex solutions are simpler to implement for complicated
extractions.
--ron