Regular Expression VBA : find particular set of data - regex

Question

I've encountered an issue with my macro.
I'm trying to find in a string, elements beginning with FP 608 or TM 608.
The string I try to extract always begins with FP or TM. The elements after are numbers, 3 or 4 numbers (100 or 1000). they can also have 2 decimals (100.10 or 1000.10).
For instance it should extract :
ABCDF FP 573,83 ABDFEG HIJ KLM 0124" : Extract : 573,83
ABCFED ERD 536,98 [...] = no extraction
TM 123,12 ABCDD EFGHIJ KLM : Extract TM 123,12
FP 100 : Extract : FP 100
This seems to work but it's inefficient :
Function GetRealCost(MyRange As Variant)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayStatusBar = False
Dim regEx As Object
Set regEx = CreateObject("vbscript.regexp")
Dim strPattern As String
Dim strInput As String
Dim strOutput As Object
strPattern = "\b(TM )([0-9]{3,4})(,[0-9]{1,2}\b)"
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
strInput = MyRange
If regEx.test(strInput) Then
regEx.Pattern = "(\b[0-9]{3,4})(,[0-9]{1,2}\b)"
Set strOutput = regEx.Execute(MyRange)
GetRealCost = regEx.Execute(strInput)(0)
Else
strPattern = "\b(TM )([0-9]{3,4}\b)"
regEx.Pattern = strPattern
If regEx.test(strInput) Then
regEx.Pattern = "(\b[0-9]{3,4}\b)"
Set strOutput = regEx.Execute(MyRange)
GetRealCost = regEx.Execute(strInput)(0)
Else
strPattern = "\b(FP )([0-9]{3,4})(,[0-9]{1,2}\b)"
regEx.Pattern = strPattern
If regEx.test(strInput) Then
regEx.Pattern = "(\b[0-9]{3,4})(,[0-9]{1,2}\b)"
Set strOutput = regEx.Execute(MyRange)
GetRealCost = regEx.Execute(strInput)(0)
Else
strPattern = "\b(FP )([0-9]{3,4}\b)"
regEx.Pattern = strPattern
If regEx.test(strInput) Then
regEx.Pattern = "(\b[0-9]{3,4}\b)"
Set strOutput = regEx.Execute(MyRange)
GetRealCost = regEx.Execute(strInput)(0)
Else
GetRealCost = ""
End If
End If
End If
End If
Application.ScreenUpdating = True
End Function
Thank you !

Answer 1

The inefficieny is mainly due to applying and testing many regular expressions, which all can be merged into a single one. Also, code speed can be improved by creating and setting that RegExp object only once, because creating and setting it for each cell using the formula may turn really ineffective.
Finally, I dont believe that it's a good idea to disable/enable the screen updating and other stuff inside a UDF, because that will apply once for each individually calculated cell, which is counter-intuitive, and it will have no effect actually because UDF's are not allowed to change the state of the application apart from computing a result.
You might try this UDF instead:
Function GetRealCost(strInput As String) As String
Static reg As Object
If reg Is Nothing Then
Set reg = CreateObject("vbscript.RegExp")
reg.Global = True
reg.MultiLine = True
reg.IgnoreCase = False
reg.Pattern = "\b((FP )|(TM ))\d{3,4}(,\d{1,2})?\b"
End If
Dim matches As Object: Set matches = reg.Execute(strInput)
If matches.count <> 0 Then GetRealCost = Mid(matches(0), 4)
End Function