Extract Numbers from Memo field

[Dave]

Hope someone can help!
I have a memo fiels in which there are a few numbers including dates but
what I want to do is extract a number which is 6 figures long. Can anyone
help me?
Thanks Dave

[Larry Linson]

"Dave" wrote

I have a memo fiels in which there are
a few numbers including dates but
what I want to do is extract a number
which is 6 figures long. Can anyone
help me?

What indication do you have exactly where the text representing that number
_is_ in the Memo Field? The Left, Right, and Mid functions work nicely to
extract a text string from a larger text string, but you have to know the
character position where it begins (and where it ends, or how long it is).
If it is preceded by some title/label, it may be possible to use the InStr
function to locate the title/label's location, then add the necessary length
to determine the first character of the numeric string.

Larry Linson
Microsoft Access MVP

[Dave]

The only indication I have is that it is 6 figures long and looking at a
sample in the field it seems to be the only one that is this number of
figures. It is all I have to work with.

"Dave" <da*******@btinternet.comwrote in message
news:de********************@bt.com...

Hope someone can help!
I have a memo fiels in which there are a few numbers including dates
but what I want to do is extract a number which is 6 figures long. Can
anyone help me?
Thanks Dave

[Lyle Fairfield]

Dave wrote:

Hope someone can help!
I have a memo fiels in which there are a few numbers including dates but
what I want to do is extract a number which is 6 figures long. Can anyone
help me?
Thanks Dave

This requires that VB Script be installed. TTBOMK it is installed by
default with Windows >=2000.

Public Function SixDigitNumerals(ByVal vInput As String) As Variant
' assumes VBScript is installed
Dim RE As Object
Dim SDNMatches As Object
Dim SDN As Variant
Dim SDNS As String
Set RE = CreateObject("VBScript.RegExp")
With RE
.Global = True
.Pattern = "(\b|\D)\d{6}(\D|\b)"
End With
Set SDNMatches = RE.Execute(vInput)
For Each SDN In SDNMatches
SDNS = SDNS & "," & Mid$(SDN, 2, 6)
Next SDN
SDNS = Replace(SDNS, ",", "", , 1)
SixDigitNumerals = Split(SDNS, ",")

End Function

Sub test()
Dim s As Variant
Dim ss As Variant
s = SixDigitNumerals("a666666da55555a7777777g000000")
For Each ss In s
Debug.Print ss
Next ss
End Sub

It returns 666666 and 000000

It does not return the five digit 55555 nor the seven digit 7777777. It
could be adjusted according to your needs.

The function is not mature. I dashed it off while waiting for supper,
so it's only very slightly advanced beyond air code.

Maybe it needs the two objects to be released. I tend not to do this
unless VBA forces me to.

I wrote this in Google's TextBox ... at times it went nuts and showed
everything several times ... I hope it posts OK.

[Lyle Fairfield]

The function posted previously did not handle "666666abc..." correctly.
This is a revision with notes:

Public Function SixDigitNumerals(ByVal vInput As String) As Variant

' creates pointers to objects
Dim RE As Object
Dim RE2 As Object

' creates pointers to objects
Dim SDNMatches As Object
Dim SDNMatches2 As Object

' creates a pointer to a variant
Dim SDN As Variant

' creates a pointer to a string
Dim SDNS As String

' references the VBScript Library
' reserves space in memory
' for twp VBScript Regular Expression Objects
' adn their objects and properties
' and loads default values
Set RE = CreateObject("VBScript.RegExp")
Set RE2 = CreateObject("VBScript.RegExp")

' establishes the pattern
' which Regular Expression 2 will attempt to match
' this pattern is
' 6 digits
RE2.Pattern = "\d{6}"

With RE
' sets the Global Property
' of Regular Expression 1 to True
' thus directing that all searches and matches
' will find all matching patterns
' rather than just the first one
.Global = True

' establishes the pattern
' which the Regular Expression will attempt to match
' this pattern is

' (\^|\D) -begin at a input beginning
' or a non-digit character

' \d{6} -six digits

' (\D|\b) -end at a non-digit character
' or at input end
.Pattern = "(^|\D)\d{6}(\D|$)"
End With

' performs a search, matching
' in vInput for the pattern
' established above
' storing results in SDNMatches
' a collection like object
Set SDNMatches = RE.Execute(vInput)

For Each SDN In SDNMatches
' performs a search
' on each of the matches found
' matching just the 6 digits
Set SDNMatches2 = RE2.Execute(SDN)

' adds a comma
' and the 6 digit substring
' to our working string
SDNS = SDNS & "," & SDNMatches2(0)
Next SDN

' removes the first comma from the working string
SDNS = Replace(SDNS, ",", "", , 1)

' splits SDNS into a variant array
' of all 6 digit numerals in vInput
' and assigns the array to the function
' as its value
' (returns the array)
SixDigitNumerals = Split(SDNS, ",")
End Function

[RoyVidar]

"Lyle Fairfield" <ly***********@aim.comwrote in message
<11**********************@m73g2000cwd.googlegroups .com>:

The function posted previously did not handle "666666abc..."
correctly. This is a revision with notes:

Public Function SixDigitNumerals(ByVal vInput As String) As Variant

' creates pointers to objects
Dim RE As Object
Dim RE2 As Object

' creates pointers to objects
Dim SDNMatches As Object
Dim SDNMatches2 As Object

' creates a pointer to a variant
Dim SDN As Variant

' creates a pointer to a string
Dim SDNS As String

' references the VBScript Library
' reserves space in memory
' for twp VBScript Regular Expression Objects
' adn their objects and properties
' and loads default values
Set RE = CreateObject("VBScript.RegExp")
Set RE2 = CreateObject("VBScript.RegExp")

' establishes the pattern
' which Regular Expression 2 will attempt to match
' this pattern is
' 6 digits
RE2.Pattern = "\d{6}"

With RE
' sets the Global Property
' of Regular Expression 1 to True
' thus directing that all searches and matches
' will find all matching patterns
' rather than just the first one
.Global = True

' establishes the pattern
' which the Regular Expression will attempt to match
' this pattern is

' (\^|\D) -begin at a input beginning
' or a non-digit character

' \d{6} -six digits

' (\D|\b) -end at a non-digit character
' or at input end
.Pattern = "(^|\D)\d{6}(\D|$)"
End With

' performs a search, matching
' in vInput for the pattern
' established above
' storing results in SDNMatches
' a collection like object
Set SDNMatches = RE.Execute(vInput)

For Each SDN In SDNMatches
' performs a search
' on each of the matches found
' matching just the 6 digits
Set SDNMatches2 = RE2.Execute(SDN)

' adds a comma
' and the 6 digit substring
' to our working string
SDNS = SDNS & "," & SDNMatches2(0)
Next SDN

' removes the first comma from the working string
SDNS = Replace(SDNS, ",", "", , 1)

' splits SDNS into a variant array
' of all 6 digit numerals in vInput
' and assigns the array to the function
' as its value
' (returns the array)
SixDigitNumerals = Split(SDNS, ",")
End Function

I've taken the liberty of doing a small alteration of the pattern -
grouping, then doing some alterations of the function, utilizing the
submatches collection of the match object (watch for linebreaks).
http://msdn.microsoft.com/library/de...0e7e82faa5.asp

Function rvsSixDigits(ByVal v_strIn As String) As Variant

Dim re As Object
Dim SDNMatches As Object
Dim SDN As Object
Dim SDNS As String

Set re = CreateObject("vbscript.regexp")

With re
.Global = True
.Pattern = "(^|\D)(\d{6})(\D|$)"
Set SDNMatches = .Execute(v_strIn)
For Each SDN In SDNMatches
SDNS = SDNS & "," & SDN.SubMatches(1)
Next SDN
SDNS = Replace(SDNS, ",", "", , 1)
End With

rvsSixDigits = Split(SDNS, ",")

End Function

--
Roy-Vidar

[Lyle Fairfield]

RoyVidar wrote:

Function rvsSixDigits(ByVal v_strIn As String) As Variant

Dim re As Object
Dim SDNMatches As Object
Dim SDN As Object
Dim SDNS As String

Set re = CreateObject("vbscript.regexp")

With re
.Global = True
.Pattern = "(^|\D)(\d{6})(\D|$)"
Set SDNMatches = .Execute(v_strIn)
For Each SDN In SDNMatches
SDNS = SDNS & "," & SDN.SubMatches(1)
Next SDN
SDNS = Replace(SDNS, ",", "", , 1)
End With

rvsSixDigits = Split(SDNS, ",")

End Function

Very nice; I didn't know VBScript's RegExp had submatches, and have
never been successful in VBS with using $n.
I think if one wanted an example of why we strive for elegant solutions
one might read this thread.