Custom UDF to Extract Numbers

[sbeatton]

I am trying to write a UDF to extract sections of formulae from the below. I found the custom UDF below but not having much fun trying to understannd it. Am I going about this the right way / can someone please assist (even if setting me on the right track).

Excel Workbook
	C	D	E	F
1	Formula	Part 1	Part 2	Part 3
2	$ 1,126.87	1126.87	0	0
3	$ 753.26	751.26	0	2
4	$ 356.45	356.45
Sheet1

This is the UDF I am tring to utilise (copied from PGC01 http://www.mrexcel.com/forum/showthread.php?t=308297&highlight=split+formula+number)

Function Getnumber(r As Range, lIndex As Long) As Variant
Dim oMatches As Object
 
    If r.Count > 1 Then Exit Function
    
    With CreateObject("vbscript.regexp")
        .Pattern = "\W\d+"
        .Global = True
        
        Set oMatches = .Execute(r.Formula)
    End With
        
    If oMatches.Count >= lIndex Then
        Getnumber = Mid(oMatches(lIndex - 1), 2)
    Else
        Getnumber = ""
    End If
End Function

 

[sbeatton]

This might be clearer.
I have a formula with three sets of brackets. I need to extract each into an individual cell.
i.e A1 = (1)+(2)+(3)
Result will be
A2 = 1
A3 = 2
A4 = 3
Thanks

 

[ZVI]

Hi,

Is it you wanted?

Function GetNumber(r As Range, Optional lIndex = 1) As String
  Dim f As String, arr
  f = r.Formula
  If Mid$(f, 1, 1) = "=" Then f = Mid$(f, 2)
  f = Replace(f, "(", "~")
  f = Replace(f, ")", "~")
  arr = Split(f, "~")
  On Error Resume Next
  GetNumber = arr(lIndex * 2 - 1)
End Function

Sub test()
  [A1].Formula = "=(1048.25+78.62)+(0)+(0)"
  Debug.Print GetNumber([A1], 1)
  Debug.Print GetNumber([A1], 2)
  Debug.Print GetNumber([A1], 3)
  [A2].Value = "'" & GetNumber([A1], 1)
  [A3].Value = "'" & GetNumber([A1], 2)
  [A4].Value = "'" & GetNumber([A1], 3)
End Sub

Regards,
Vladimir

 

[Richard Schollar]

Here's a possible alternative:

Function GetNum(s As String, Optional indx As Integer = 1)
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\([\-\d\.]+"
    If .test(s) Then GetNum = Replace(.Execute(s)(indx - 1), "(", "")
End With
End Function

Use in a cell like:

=GetNum($A1,ROWS($A$1:A$1))

copied across.

 

[ZVI]

For Richard:
Hi! It is my opinion that your variant with scripting object library would be more required as it was used in request. But please take into account that it does not work for requested parsing of FORMULA (not value) in cell - refer to C2 formula in sbeatton example above.
Also GetNum() returns "1048.25" instead of required "1048.25+78.62" for mentioned formula in C2, some improving of your script is required, I think.

For sbeatton:
1. You can use cell formula for calling my version of UDF like this:
=GetNumber(C2, 1) or =GetNumber(C2, 2) and so on.
2. GetNumber() parses the cell formula as well as the string
3. If the 2nd index parameter exceeds available range, than GetNumber() returns an empty string "", if you need in Error return - just comment this line of code: On Error Resume Next.

Regards,
Vladimir

 

[Richard Schollar]

Hi Vladimir

You are absolutely correct of course - I never read the OP's original question properly, hence my suggestion didn't come close to providing a solution

Hopefully this one works better:

Function GetNum(r As Range, Optional indx As Integer = 1)
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\(.+?\)"
    If .test(r.Formula) Then GetNum = Replace(Replace(.Execute(r.Formula)(indx - 1), "(", ""), ")", "")
End With
End Function