Searching for codes in text strings

Hi All,

I have text similar to the following, which is an in-house language.
----------------------------------------------
field b831 B831 write AASLQ0300000l;

PCPACIMTAAABl [B29 ]

field B7 b7 ;
field a8 @latestdate("PCP2EHSEAAAAh", jEnd);
field b8 @if(a8 <jStart, @latest("PCP2EHSEAAAAh", jEnd),
@avg("PCP2EHSEAAAAh", jStart, jEnd));
--------------------------------------------------------

I want to look through this text and copy out any 13 character codes that
are present (e.g. "PCPACIMTAAABl" ,2 "PCP2EHSEAAAAh").

These codes all share the following characteristics,

1) they are all 13 characters in length
2) the last character in the code is always either a "l", "h" or a "c".
3) they contrain no spaces
4) the first 12 characters are always in CAPS (followed by a lower "l", "h"
or a "c".

Any help at all will be much appreciated. If you need more explanation,
please ask and I will be happily explain things further.

Regards,

Bhupinder.

In a module, paste following code:
'-------
Dim re As RegExp

Sub initre()
Set re = New RegExp
re.Pattern = "([A-Z0-9]{12}[lhc])"
re.Global = True
re.IgnoreCase = False
End Sub

Sub FindAndStoreStrings()
Dim i As Long
Dim rSearchArea As Range
Dim rSearch As Range
Dim rDestArea As Range
Dim mc As MatchCollection
Set rSearchArea = Worksheets("Sheet1").Range("A1:A8")
Set rDestArea = Worksheets("Sheet1").Range("B1")
For Each rSearch In rSearchArea
Set mc = re.Execute(rSearch.Text)
For i = 0 To mc.Count - 1
rDestArea.Value = mc(i).Value
Set rDestArea = rDestArea.Offset(1, 0)
Next i
Next rSearch
End Sub
'---------

In ThisWorkBook code, paste the following
'-----------
Private Sub Workbook_Open()
Call initre
End Sub
'---------

Run macro FindAndStoreStrings

HTH
--
AP


"Bhupinder Rayat" <[email protected]> a écrit dans le
message de news:[email protected]...
> Hi All,
>
> I have text similar to the following, which is an in-house language.
> ----------------------------------------------
> field b831 B831 write AASLQ0300000l;
>
> PCPACIMTAAABl [B29 ]
>
> field B7 b7 ;
> field a8 @latestdate("PCP2EHSEAAAAh", jEnd);
> field b8 @if(a8 <jStart, @latest("PCP2EHSEAAAAh", jEnd),
> @avg("PCP2EHSEAAAAh", jStart, jEnd));
> --------------------------------------------------------
>
> I want to look through this text and copy out any 13 character codes that
> are present (e.g. "PCPACIMTAAABl" ,2 "PCP2EHSEAAAAh").
>
> These codes all share the following characteristics,
>
> 1) they are all 13 characters in length
> 2) the last character in the code is always either a "l", "h" or a "c".
> 3) they contrain no spaces
> 4) the first 12 characters are always in CAPS (followed by a lower "l",
"h"
> or a "c".
>
> Any help at all will be much appreciated. If you need more explanation,
> please ask and I will be happily explain things further.
>
> Regards,
>
> Bhupinder.

On Wed, 26 Apr 2006 01:51:01 -0700, Bhupinder Rayat
<[email protected]> wrote:

> Hi All,
>
>I have text similar to the following, which is an in-house language.
>----------------------------------------------
>field b831 B831 write AASLQ0300000l;
>
>PCPACIMTAAABl [B29 ]
>
>field B7 b7 ;
>field a8 @latestdate("PCP2EHSEAAAAh", jEnd);
>field b8 @if(a8 <jStart, @latest("PCP2EHSEAAAAh", jEnd),
>@avg("PCP2EHSEAAAAh", jStart, jEnd));
>--------------------------------------------------------
>
>I want to look through this text and copy out any 13 character codes that
>are present (e.g. "PCPACIMTAAABl" ,2 "PCP2EHSEAAAAh").
>
>These codes all share the following characteristics,
>
>1) they are all 13 characters in length
>2) the last character in the code is always either a "l", "h" or a "c".
>3) they contrain no spaces
>4) the first 12 characters are always in CAPS (followed by a lower "l", "h"
>or a "c".
>
>Any help at all will be much appreciated. If you need more explanation,
>please ask and I will be happily explain things further.
>
>Regards,
>
>Bhupinder.

This can be done fairly simply with regular expressions. If your total string
lengths are <= 255, then download and install Longre's free morefunc.xll add-in
from http://xcell05.free.fr/

Use the formula:

=REGEX.MID(A1,"\b\w{12}(1|h|c)\b")

If there could be multiple matching codes in the same string, there is an
optional third argument in the function to select the instance (and it returns
a null string if there is none).

If your string lengths might be greater than 255, you can use Microsoft
VBScript Regular Expressions and write a UDF to do the same thing.


--ron

Hi Ardus,

I am getting error messages saying "User-defined Type not defined.

It doesn't like Dim re As RegExp, Set re = New RegExp and Dim mc As
MatchCollection.

Also, shouldn't the first dim statement be within a module? I tried but same
problem.

Thanks,

Bhupinder.

"Ardus Petus" wrote:

> In a module, paste following code:
> '-------
> Dim re As RegExp
>
> Sub initre()
> Set re = New RegExp
> re.Pattern = "([A-Z0-9]{12}[lhc])"
> re.Global = True
> re.IgnoreCase = False
> End Sub
>
> Sub FindAndStoreStrings()
> Dim i As Long
> Dim rSearchArea As Range
> Dim rSearch As Range
> Dim rDestArea As Range
> Dim mc As MatchCollection
> Set rSearchArea = Worksheets("Sheet1").Range("A1:A8")
> Set rDestArea = Worksheets("Sheet1").Range("B1")
> For Each rSearch In rSearchArea
> Set mc = re.Execute(rSearch.Text)
> For i = 0 To mc.Count - 1
> rDestArea.Value = mc(i).Value
> Set rDestArea = rDestArea.Offset(1, 0)
> Next i
> Next rSearch
> End Sub
> '---------
>
> In ThisWorkBook code, paste the following
> '-----------
> Private Sub Workbook_Open()
> Call initre
> End Sub
> '---------
>
> Run macro FindAndStoreStrings
>
> HTH
> --
> AP
>
>
> "Bhupinder Rayat" <[email protected]> a écrit dans le
> message de news:[email protected]...
> > Hi All,
> >
> > I have text similar to the following, which is an in-house language.
> > ----------------------------------------------
> > field b831 B831 write AASLQ0300000l;
> >
> > PCPACIMTAAABl [B29 ]
> >
> > field B7 b7 ;
> > field a8 @latestdate("PCP2EHSEAAAAh", jEnd);
> > field b8 @if(a8 <jStart, @latest("PCP2EHSEAAAAh", jEnd),
> > @avg("PCP2EHSEAAAAh", jStart, jEnd));
> > --------------------------------------------------------
> >
> > I want to look through this text and copy out any 13 character codes that
> > are present (e.g. "PCPACIMTAAABl" ,2 "PCP2EHSEAAAAh").
> >
> > These codes all share the following characteristics,
> >
> > 1) they are all 13 characters in length
> > 2) the last character in the code is always either a "l", "h" or a "c".
> > 3) they contrain no spaces
> > 4) the first 12 characters are always in CAPS (followed by a lower "l",
> "h"
> > or a "c".
> >
> > Any help at all will be much appreciated. If you need more explanation,
> > please ask and I will be happily explain things further.
> >
> > Regards,
> >
> > Bhupinder.
>
>
>

Hi Ron,

wow thats impressive!

Thank you for opening up the world of RegEx to me, I can certainly utilise
it and create little programs that will help my team greatly!

Still couldn't get Ardus's code to compile though. I even used createObject
and linked to vbscript, and it then recognised the RegExp command, but it
still didn't like the MatchCollection command. Any Ideas?

Thank you for your help.

Bhupinder

"Ron Rosenfeld" wrote:

> On Wed, 26 Apr 2006 01:51:01 -0700, Bhupinder Rayat
> <[email protected]> wrote:
>
> > Hi All,
> >
> >I have text similar to the following, which is an in-house language.
> >----------------------------------------------
> >field b831 B831 write AASLQ0300000l;
> >
> >PCPACIMTAAABl [B29 ]
> >
> >field B7 b7 ;
> >field a8 @latestdate("PCP2EHSEAAAAh", jEnd);
> >field b8 @if(a8 <jStart, @latest("PCP2EHSEAAAAh", jEnd),
> >@avg("PCP2EHSEAAAAh", jStart, jEnd));
> >--------------------------------------------------------
> >
> >I want to look through this text and copy out any 13 character codes that
> >are present (e.g. "PCPACIMTAAABl" ,2 "PCP2EHSEAAAAh").
> >
> >These codes all share the following characteristics,
> >
> >1) they are all 13 characters in length
> >2) the last character in the code is always either a "l", "h" or a "c".
> >3) they contrain no spaces
> >4) the first 12 characters are always in CAPS (followed by a lower "l", "h"
> >or a "c".
> >
> >Any help at all will be much appreciated. If you need more explanation,
> >please ask and I will be happily explain things further.
> >
> >Regards,
> >
> >Bhupinder.
>
> This can be done fairly simply with regular expressions. If your total string
> lengths are <= 255, then download and install Longre's free morefunc.xll add-in
> from http://xcell05.free.fr/
>
> Use the formula:
>
> =REGEX.MID(A1,"\b\w{12}(1|h|c)\b")
>
> If there could be multiple matching codes in the same string, there is an
> optional third argument in the function to select the instance (and it returns
> a null string if there is none).
>
> If your string lengths might be greater than 255, you can use Microsoft
> VBScript Regular Expressions and write a UDF to do the same thing.
>
>
> --ron
>

On Wed, 26 Apr 2006 04:24:01 -0700, Bhupinder Rayat
<[email protected]> wrote:

>Hi Ron,
>
>wow thats impressive!
>
>Thank you for opening up the world of RegEx to me, I can certainly utilise
>it and create little programs that will help my team greatly!
>
>Still couldn't get Ardus's code to compile though. I even used createObject
>and linked to vbscript, and it then recognised the RegExp command, but it
>still didn't like the MatchCollection command. Any Ideas?
>
>Thank you for your help.
>
>Bhupinder

For Ardus's version, you need to set a reference (Tools/References) to
"Microsoft VBScript Regular Expressions 5.5" which should be in the dropdown
list.


--ron

Thanks Ron,

but now it doesnt like Set mc = re.Execute(rSearch.Text), error message says
"Object variable or With block variable not set".

Any ideas?

Thanks again,

Bhupinder

"Ron Rosenfeld" wrote:

> On Wed, 26 Apr 2006 04:24:01 -0700, Bhupinder Rayat
> <[email protected]> wrote:
>
> >Hi Ron,
> >
> >wow thats impressive!
> >
> >Thank you for opening up the world of RegEx to me, I can certainly utilise
> >it and create little programs that will help my team greatly!
> >
> >Still couldn't get Ardus's code to compile though. I even used createObject
> >and linked to vbscript, and it then recognised the RegExp command, but it
> >still didn't like the MatchCollection command. Any Ideas?
> >
> >Thank you for your help.
> >
> >Bhupinder
>
> For Ardus's version, you need to set a reference (Tools/References) to
> "Microsoft VBScript Regular Expressions 5.5" which should be in the dropdown
> list.
>
>
> --ron
>

On Wed, 26 Apr 2006 04:56:02 -0700, Bhupinder Rayat
<[email protected]> wrote:

>Thanks Ron,
>
>but now it doesnt like Set mc = re.Execute(rSearch.Text), error message says
>"Object variable or With block variable not set".
>
>Any ideas?
>
>Thanks again,
>
>Bhupinder
>

Well, my first suggestion would be to use Longre's morefunc add-in and the
Regex formulas I posted previously. Morefunc can be easily distributed with a
workbook.

If you must use a VBA solution, then I would use this one, which I wrote myself
so I know it works, and use =REMID(A1,"\b\w{12}(1|h|c)\b")

(same pattern but different formula).

Again, if you have multiple codes within the string, there is an optional third
argument to parse out the instance.

And also, you'll have to set the reference to vbscript as I previously wrote.

===============================
Option Explicit
Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True) _
As Variant 'Variant as value may be string or array

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Dim i As Long 'counter
Dim t() As String 'container for array results

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then

'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.

On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
===============================
--ron

Thanks Ron,

Works like a charm. I am very grateful.

Happy coding,

Bhupinder.

"Ron Rosenfeld" wrote:

> On Wed, 26 Apr 2006 04:56:02 -0700, Bhupinder Rayat
> <[email protected]> wrote:
>
> >Thanks Ron,
> >
> >but now it doesnt like Set mc = re.Execute(rSearch.Text), error message says
> >"Object variable or With block variable not set".
> >
> >Any ideas?
> >
> >Thanks again,
> >
> >Bhupinder
> >
>
> Well, my first suggestion would be to use Longre's morefunc add-in and the
> Regex formulas I posted previously. Morefunc can be easily distributed with a
> workbook.
>
> If you must use a VBA solution, then I would use this one, which I wrote myself
> so I know it works, and use =REMID(A1,"\b\w{12}(1|h|c)\b")
>
> (same pattern but different formula).
>
> Again, if you have multiple codes within the string, there is an optional third
> argument to parse out the instance.
>
> And also, you'll have to set the reference to vbscript as I previously wrote.
>
> ===============================
> Option Explicit
> Function REMid(str As String, Pattern As String, _
> Optional Index As Variant = 1, _
> Optional CaseSensitive As Boolean = True) _
> As Variant 'Variant as value may be string or array
>
> Dim objRegExp As RegExp
> Dim objMatch As Match
> Dim colMatches As MatchCollection
>
> Dim i As Long 'counter
> Dim t() As String 'container for array results
>
> ' Create a regular expression object.
> Set objRegExp = New RegExp
>
> 'Set the pattern by using the Pattern property.
> objRegExp.Pattern = Pattern
>
> ' Set Case Insensitivity.
> objRegExp.IgnoreCase = Not CaseSensitive
>
> 'Set global applicability.
> objRegExp.Global = True
>
> 'Test whether the String can be compared.
> If (objRegExp.Test(str) = True) Then
>
> 'Get the matches.
> Set colMatches = objRegExp.Execute(str) ' Execute search.
>
> On Error Resume Next 'return null string if a colmatch index is non-existent
> If IsArray(Index) Then
> ReDim t(1 To UBound(Index))
> For i = 1 To UBound(Index)
> t(i) = colMatches(Index(i) - 1)
> Next i
> REMid = t()
> Else
> REMid = CStr(colMatches(Index - 1))
> If IsEmpty(REMid) Then REMid = ""
> End If
> On Error GoTo 0 'reset error handler
> Else
> REMid = ""
> End If
> End Function
> ===============================
> --ron
>

On Thu, 27 Apr 2006 03:10:02 -0700, Bhupinder Rayat
<[email protected]> wrote:

>Thanks Ron,
>
>Works like a charm. I am very grateful.
>
>Happy coding,

Glad to help. Thanks for the feedback.


--ron