Home > Mobile >  Simplify parameters of excel formula using VBA
Simplify parameters of excel formula using VBA

Time:09-30

If I have a UDF that has the parameters as such:

=MySampleUDF(150 127.193,1000,240-30-12)

How can I use VBA to reduce the above to this (i.e. calculate & simplify all the parameters):

=MySampleUDF(277.193,1000,198)

I've tried to think of ways that involve Regex, but really there must be a simpler way?

CodePudding user response:

So, you want to Evaluate each parameter in the Formula, and turn it into a single value?

The method below is far from perfect; if your parameter includes a formula, then it will fail (e.g. =MySampleUDF(150 127.193,999 1 PRODUCT(7 3,0),240-30-12) will result in =MySampleUDF(277.193,999 1 PRODUCT(10,0),198)), but it forms an almost-decent starting point, and doesn't require any advanced understanding. There are, undoubtedly, many ways to improve it, with more time.

Sub SimplifyParameters(Target AS Range)
    Dim aBrackets AS Variant, bClose As Boolean, aParams AS Variant
    Dim lCurrBracket AS Long, lCurrParam As Long, rCurrCell AS Range
    Dim sProcessBracket AS String, vEvaluated AS Variant
    
    For Each rCurrCell In Target.Cells 'In case you input more than 1 cell
        If Len(rCurrCell.Formula)>0 Then 'Ignore blank cells
            aBrackets = Split(rCurrCell.Formula, "(") 'Split by Function
            
            For lCurrBracket = lBound(aBrackets) to UBound(aBrackets)
                aProcessBracket = aBrackets(lCurrBracket)
                bClose = (Right(sProcessBracket,1)=")")
                If bClose Then sProcessBracket = Left(sProcessBracket, Len(sProcessBracket)-1)
                
                aParams = Split(sProcessBracket, ",") 'Split by Parameter
                For lCurrParam = lBound(aParams) to uBound(aParams)
                    vEvaluated - Evaluate(aParams(lCurrParam))
                    If Not IsError(vEvaluated) Then aParams(lCurrParam) = vEvaluated
                Next lCurrParam
                
                aBrackets(lCurrBracket) = Join(aParams, ",") & IIF(bClose, ")", "") 'Recombine Parameters
            Next lCurrBracket
            
            rCurrCell.Formula = Join(aBrackets, "(") 'Recombine Functions
        End If
    Next rCurrCell
End Sub

It Splits the Formula on "(", to separate functions

"=MySampleUDF(150 127.193,1000,240-30-12)"
    [0] = "=MySampleUDF"
    [1] = "150 127.193,1000,240-30-12)"

Then it goes through those, removes the ")", and Splits them on ","

"=MySampleUDF"
    [0] = "=MySampleUDF"

"150 127.193,1000,240-30-12"
    [0] = "150 127.193"
    [1] = "1000"
    [2] = "240-30-12"

Then it runs the Evaluate function on each of those and, if the result is not an error, substitutes it in

Evaluate("=MySampleUDF") = Error 2029
Evaluate("150 127.193") = 277.193
Evaluate("1000") = 1000
Evaluate("240-30-12") = 198

Then it Joins the Parameters back together, and restores any removed ")"

Join(Array("=MySampleUDF"), ",") & "" = "=MySampleUDF"
Join(Array(277.193, 1000, 198), ",") & ")" = "277.193,1000,198)"

Finally, it Joins the Functions back together

Join(Array("=MySampleUDF", "277.193,1000,198)"), "(") = "=MySampleUDF(277.193,1000,198)"

CodePudding user response:

Here is a subroutine that takes the selected cell and parses out the arguments of the any function, then evaluates each one and re-composes the formula definition.

For example the selected cell has =SUM(1 2 3,10) as formula.

After calling the sub the cell has =SUM(6,10) as formula

Public Sub EvalParams()
    Dim r As Range
    
    For Each r In Selection
        
        Dim f As String
        f = r.Formula
        
        If Left(f, 1) = "=" Then
            Dim i_open  As Long
            i_open = InStr(2, f, "(")
            Dim id As String
            ' Get UDF name
            id = Mid(f, 2, i_open - 2)
            
            Dim i_close As Long
            i_close = InStr(i_open   1, f, ")")
            
            Dim args() As String
            ' Seperate arguments by comma
            args = VBA.Split(Mid(f, i_open   1, i_close - i_open - 1), ",")
            
            Dim i As Long
            ' Evaluate each argument separately
            For i = 0 To UBound(args)
                args(i) = CStr(Evaluate(args(i)))
            Next i
            
            ' Compose formula again
            f = "=" & id & "(" & VBA.Join(args, ",") & ")"
            
            r.Formula = f
        End If
    
    Next r
    
End Sub

NOTE: This will fail if you have multiple function calls in the formula, like

=SUM(1,2,3)   SUM(4,5)
  • Related