Modify code in UDF

[Biff]

Hi Folks!

I was following a thread awhile back in which Dana DeLouis posted this UDF
that returns the last string of numbers contained inside a string:

11xxx1xx10 = 10
aa22xxxxxx = 22
2xxxxxxxxx = 2
xx12xxx5xx = 5

This works beautifully when the "numbers" are integers.

Can this code be modified to return the number string if it also contains
decimals?

As is, it won't:

11xxx10.1 = 1
xxx5.25xx = 25

Where the above should return:

10.1
5.25

Here's the code:

Option Explicit
Public RE As RegExp

Function LastGroupOfNumbers(s)
'// Microsoft VBScript Regular Expressions 5.5

Dim Matches As MatchCollection
Const k As String = "(\d+)\D*$"

If RE Is Nothing Then Set RE = New RegExp
With RE
.IgnoreCase = True
.Global = True
.Pattern = k

If .Test(s) Then
Set Matches = .Execute(s)
LastGroupOfNumbers = Matches(0).SubMatches(0)
End If
End With
End Function

Thanks

Biff

 

[Bob Phillips]

Public RE As RegExp

Function LastGroupOfNumbers(s)
'// Microsoft VBScript Regular Expressions 5.5

Dim Matches As MatchCollection
Const k As String = "(\d+\.\d+|\d+)\D*$"

If RE Is Nothing Then Set RE = New RegExp
With RE
.IgnoreCase = True
.Global = True
.Pattern = k

If .Test(s) Then
Set Matches = .Execute(s)
LastGroupOfNumbers = Matches(0).SubMatches(0)
End If
End With
End Function


--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[RB Smissaert]

I got a function for this that doesn't look as nice as the one with VB
Script, but it is about twice as fast and
it doesn't need the reference to the VBScript Regular Expressions library.

Just showing the whole lot, including the testing:

Option Explicit
Private RE As RegExp
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private lStartTime As Long
Private lEndTime As Long

Sub StartSW()
lStartTime = timeGetTime()
End Sub

Sub StopSW(Optional ByRef strMessage As Variant = "")
lEndTime = timeGetTime()
MsgBox "Done in " & lEndTime - lStartTime & " msecs", , strMessage
End Sub

Function LastGroupOfNumbers(s)
'// Microsoft VBScript Regular Expressions 5.5

Dim Matches As MatchCollection
Const k As String = "(\d+\.\d+|\d+)\D*$"

If RE Is Nothing Then Set RE = New RegExp
With RE
.IgnoreCase = True
.Global = True
.Pattern = k

If .test(s) Then
Set Matches = .Execute(s)
LastGroupOfNumbers = Matches(0).SubMatches(0)
End If
End With

End Function

Sub test()

Dim i As Long
Dim str As String

StartSW

For i = 0 To 10000
'str = LastGroupOfNumbers("aaaaaa222220.03333ppkkkkkk")
str = GetLastNumberFromString("aaaaaa222220.03333ppkkkkkk", ".")
'str = GetLastNumberFromString("aaaaaa222220,03333ppkkkkkk", ",")
Next

StopSW

MsgBox str, , Len(str)

End Sub

Function GetLastNumberFromString(strString As String, _
strSeparator As String) As String

Dim aByte() As Byte
Dim btSeparator() As Byte
Dim i As Long
Dim c As Long
Dim lLast As Long
Dim lFirst As Long
Dim bFoundDot As Boolean
Dim strNumber As String

aByte() = strString
btSeparator() = strSeparator

For i = UBound(aByte) - 1 To 0 Step -2
If aByte(i) > 47 And aByte(i) < 58 Then
lLast = i
For c = lLast - 2 To 0 Step -2
If aByte(c) > 57 Or _
(aByte(c) < 48 And _
aByte(c) <> btSeparator(0)) Then
lFirst = c + 2
GoTo GETOUT
End If
If aByte(c) = btSeparator(0) Then
If bFoundDot = False Then
bFoundDot = True
Else
lFirst = c + 2
GoTo GETOUT
End If
End If
Next
End If
Next

GETOUT:

For i = lFirst \ 2 + 1 To lLast \ 2 + 1
strNumber = strNumber & Mid$(strString, i, 1)
Next

GetLastNumberFromString = strNumber

End Function


RBS

 

[RB Smissaert]

OK, the VB Script one will suffer from a longer string before the number and
the loop function will
suffer from a longer string after the number.
So it will depend what you are testing on, particularly where you expect the
number to be.
Still if the number could be anywhere the loop function will be faster on
average it seems.

Sub test()

Dim i As Long
Dim str As String
Dim strTest As String

strTest = String(100, "a") & 222220.03333 & String(100, "a")

StartSW

For i = 0 To 10000
'str = LastGroupOfNumbers(strTest)
str = GetLastNumberFromString(strTest, ".")
Next

StopSW

MsgBox str, , Len(str)

End Sub


RBS

 

[Biff]

Hi Bob!

Very close but with a little hitch...

If the number string is ONLY a decimal:

11xxx10.5xx = 10.5

11xxxxx.5xx = 5

Biff

 

[Biff]

Hi!

I'm not VB/VBA literate!

I don't know how much of what you posted I actually need but I copy/pasted
the whole code and it wouldn't run unless I used the VBScript Regular
Expressions library.

If the string was:

11xxx10.5xxx = 10.5

But if it was:

11xxx.5xx = 5

Thanks for your time, though!

Biff

 

[RB Smissaert]

If you copy everything you will need to set a reference to Microsoft
VBScript Regular Expressions 5.5.
This is only for if you want to do speed comparisons. Otherwise you only
will need the loop function and nil else.

I can't reproduce the bug you mention, so when I try it on 11xxx.5xx I get
..5 as it should.

Run this and see what you get:

Sub test()

Dim str As String
Dim strTest As String

strTest = "11xxx.5xx"

str = GetLastNumberFromString(strTest, ".")

MsgBox str, , Len(str)

End Sub

It gives me .5
If you want you could add some code to the loop function to stick a zero at
the start when the first character is
a dot or whatever the separator is:


Function GetLastNumberFromString(strString As String, _
strSeparator As String) As String

Dim aByte() As Byte
Dim btSeparator() As Byte
Dim i As Long
Dim c As Long
Dim lLast As Long
Dim lFirst As Long
Dim bFoundDot As Boolean
Dim strNumber As String

aByte() = strString
btSeparator() = strSeparator

For i = UBound(aByte) - 1 To 0 Step -2
If aByte(i) > 47 And aByte(i) < 58 Then
lLast = i
For c = lLast - 2 To 0 Step -2
If aByte(c) > 57 Or _
(aByte(c) < 48 And _
aByte(c) <> btSeparator(0)) Then
lFirst = c + 2
GoTo GETOUT
End If
If aByte(c) = btSeparator(0) Then
If bFoundDot = False Then
bFoundDot = True
Else
lFirst = c + 2
GoTo GETOUT
End If
End If
Next
End If
Next

GETOUT:

For i = lFirst \ 2 + 1 To lLast \ 2 + 1
strNumber = strNumber & Mid$(strString, i, 1)
Next

If Left$(strNumber, 1) = strSeparator Then
strNumber = "0" & strNumber
End If

GetLastNumberFromString = strNumber

End Function



RBS

 

[Bob Phillips]

Hi Biff,

A third alternative

Public RE As RegExp

Function LastGroupOfNumbers(s)
'// Microsoft VBScript Regular Expressions 5.5

Dim Matches As MatchCollection
Const k As String = "(\d+\.\d+|\d+|\.\d+)\D*$"

If RE Is Nothing Then Set RE = New RegExp
With RE
.IgnoreCase = True
.Global = True
.Pattern = k

If .Test(s) Then
Set Matches = .Execute(s)
LastGroupOfNumbers = Matches(0).SubMatches(0)
End If
End With
End Function

Bob

 

[Bob Phillips]

Biff,

A late binding version to, no need to set the reference

Public RE As Object

Function LastGroupOfNumbers(s)
'// Microsoft VBScript Regular Expressions 5.5

Dim Matches As Object
Const k As String = "(\d+\.\d+|\d+|\.\d+)\D*$"

If RE Is Nothing Then Set RE = CreateObject("VBScript.RegExp")
With RE
.IgnoreCase = True
.Global = True
.Pattern = k

If .Test(s) Then
Set Matches = .Execute(s)
LastGroupOfNumbers = Matches(0).SubMatches(0)
End If
End With
End Function

 

[Biff]

That does it!

Thanks, Bob.

Biff

Hi Biff,

A third alternative

Public RE As RegExp

Function LastGroupOfNumbers(s)
'// Microsoft VBScript Regular Expressions 5.5

Dim Matches As MatchCollection
Const k As String = "(\d+\.\d+|\d+|\.\d+)\D*$"

If RE Is Nothing Then Set RE = New RegExp
With RE
.IgnoreCase = True
.Global = True
.Pattern = k

If .Test(s) Then
Set Matches = .Execute(s)
LastGroupOfNumbers = Matches(0).SubMatches(0)
End If
End With
End Function

Bob