On 22 Mar 2007 15:13:37 -0700, "FabZ" wrote:


Ron Rosenfeld ha scritto:

On 22 Mar 2007 08:51:24 -0700, "FabZ" wrote:

.Pattern = sDateAdopt
If oRegExp.test(c.Text) = True Then i = 11 'column K

i = 11 it uses column B (1) to paste text and anyway it fail to
recognize many dates, apparently not different from the other one,
recognized.

Better with first version of sDateAdopt and sDateReent.
Now I will check further your sub looking for what's wrong.

Thanks again.

FabZ

I have written that the date MUST be at the end of the string, the way this is
set up. Also, "adopt" or one of your variations MUST be in the string (or one
of the reenter variations) or a date will NOT be extracted.

So, in your 2nd example, the date will not be extracted because there is no
"adopt" or "reenter". If you want the date extracted under those
circumstances, you need to tell where you want it extracted.

Also, if the date is not at the end of the string, or there are <space's
within the date, nonsense may be extracted. If such is the case, you need to
be very specific as to what you want.

For example: adopt (or one of your variations) followed by
<space followed by
8 characters with no <space
followed by a <space or the <end of the string.

All this can be done; even checking, for example, that the date is of a certain
format (e.g. 2 digits followed by a dot or slash followed by 2 digits followed
by a dot or slash followed by 2 or 4 digits). But again, you need to specify
this.

Perhaps if you post a few of the strings where the date is not getting
extracted, I can see where your specifications differ from what is in the
string.

--ron

I tried to be more specific and I inserted new and different
combinations, i.e. adding <space before and after "adopted" I
obtained much more results next to 98% and I find it good.
I made Sub to work with several different "key-words" and I got dates
too.

I understand that for particular strings I would need a very specific
code and maybe I can "make up for" in a different way.

Sometimes I obtained nothing and I find that curious looking at the
reference strings:

fox terrier m. b steril toby --p.p. adopted 10.05.04
beagle f. tipic. tiger--p.p. adopted 23.12.03

Logically I could have been expected for a different solution:
no particular text composition, same cell property of other cells
but...no results.

Ok it doesn't matter to me, your sub works fine and you gave me also a
lot of explanations too, I really can't ask more.

Thanks and Have a nice day!

FabZ

Ah, seeing those examples explains the problem.

It was not clear from your original specifications that you would have strings
that did not have the "RM" strings and that you would want anything extracted
in that instance.

All we need to do is make the "RM" string optional.

Try this:

----------------------------------------------------------
Sub ExtractTattoo()
Dim i As Long
Dim c As Range

Dim oRegExp As Object
Dim colMatches As Object
Const sPattern As String = "(rm[a-z]\s?\d+)?.*(\s\S+$)"
Const sDateAdopt As String = "\s(adopted|ado|adopt\.)\s"
Const sDateReent As String = "\s(re-entered|re-ent|reenter\.)\s"

Set oRegExp = CreateObject("VBScript.RegExp")

With oRegExp
.IgnoreCase = True
.Global = True
For Each c In Selection
i = 0
.Pattern = sDateAdopt
If oRegExp.test(c.Text) = True Then i = 11 'column K
.Pattern = sDateReent
If oRegExp.test(c.Text) = True Then i = 10 'column J
.Pattern = sPattern
If oRegExp.test(c.Text) = True Then
Set colMatches = oRegExp.Execute(c.Text)
c.Offset(0, 1) = colMatches(0).submatches(0) 'rmd adj
If i < 0 Then
Cells(c.Row, i).Value = colMatches(0).submatches(1)
End If
End If
Next c
End With
End Sub
================================================


--ron