CODEWITHSUNDEEP
vbaexcelrecursion
Franco
Franco

Reputation: 87

Recursively extract values from Formula in VBA

I would like to recursively look in a formula of a range object until I find every single value of which it is composed of. Since I'm not so sure about the grammatical correctness of the previous sentence (in any case, I apologize for my English) I will try to explain what I would like to accomplish by an example (hoping this could be the simplest one):

    mysheet = "Sheet1"
    Sheets(mysheet).Range("A1").Formula = "=+B1"
    Sheets(mysheet).Range("B1").Formula = "=+C1-C2"
    Sheets(mysheet).Range("C1").Value = "value:val1" 
    Sheets(mysheet).Range("C2").Formula = "=+D1-D2"
    Sheets(mysheet).Range("D1").Value = "value:val2"
    Sheets(mysheet).Range("D2").Value = "value:val3"

Can you give me a hint (or better a draft of code) on what kind of function (a recursive one, maybe?) can return a string (let's call it my_formula) such that the command 

    MsgBox(my_formula)

will return the following: 

    A1 = +value:val1 - value:val2 + value:val3

? Please help me

Thank you

UPDATE AFTER LESS THAN ONE HOUR

Hi to all and many thanks for your answers. I would point out that the values in cells are effectively strings + I have just simple operations (+ and -) + All the dependencies are in the same sheet + I don't have ranges such as $X$1. However, I am aware of the methods/properties posted by some of you (precedent, NavigateArrow...) but what I asked is an idea on how to use in the best way this kind of method/properties without getting headaches.

Thank you again

Upvotes: 1

Views: 544

Answers (1)

Robin Mackenzie
Robin Mackenzie

Reputation: 19319

This code will work for your example - but YMMV for how it will scale to more complex formulas in real life. However, it will get you started - and then some- with how to recurse over the Precedents collection of a Range. I've commented the code but the easiest way to understand it is to step through in debug mode with F8.

Option Explicit

Sub Test()
    Dim ws As Worksheet
    Dim rng As Range
    Dim strOutput As String

    'your test case from the original question    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    With ws
        .Range("A1").Formula = "=+B1"
        .Range("B1").Formula = "=+C1-C2"
        .Range("C1").Value = "10"
        .Range("C2").Formula = "=+D1-D2"
        .Range("D1").Value = "20"
        .Range("D2").Value = "30"
    End With

    'the cell you want to start from
    Set rng = Sheet1.Range("A1")

    'get the output from calling the recursive function
    'note we pass the original formula in to kick off the function
    strOutput = rng.Address(0, 0) & GetFullFormula(rng, rng.Formula)

    'show user
    MsgBox strOutput

End Sub

Function GetFullFormula(rng As Range, strFormula As String) As String

    Dim rngPrecedents As Range
    Dim rngPrecedent As Range
    Dim strPrecedentAddress As String
    Dim strPrecedentFormula As String

    If rng.HasFormula Then
        Set rngPrecedents = rng.Precedents
        For Each rngPrecedent In rngPrecedents
            'get the precedent cell address to check if in current formula (without $)
            strPrecedentAddress = rngPrecedent.Address(0, 0)
            'Debug.Print strFormula
            'substiute into formula if matching a range address
            If rngPrecedent.HasFormula Then
                If InStr(1, strFormula, strPrecedentAddress, vbBinaryCompare) Then
                    'strip = from formula and put in brackets to preserve ordering
                    strPrecedentFormula = "(" & Mid(rngPrecedent.Formula, 2, Len(rngPrecedent.Formula) - 1) & ")"
                    'replace our formula with precedent formula
                    strFormula = Replace(strFormula, strPrecedentAddress, strPrecedentFormula)
                End If
                'carry on with recursion - passes formula back into function for expansion
                GetFullFormula rngPrecedent, strFormula 
            Else
                'just a value
                If InStr(1, strFormula, strPrecedentAddress, vbBinaryCompare) Then
                    'replace the address with the value
                    strFormula = Replace(strFormula, strPrecedentAddress, rngPrecedent.Value)
                End If
            End If
        Next rngPrecedent
    End If

    GetFullFormula = strFormula

End Function

Output:

=+(+10-(+20-30))

There will be a problem with this code if you are using cell references like $A$1 because the function expects plain cell references. The code could be extended to handle these cases, and named ranges too, but this is just a basic example.

Upvotes: 2

Related Questions