7

Below is the example set in Excel,

[column1] [column2]

A1  =C3-C5

A2  =((C4-C6)/C6)

A3  =C4*C3

A4  =C6/C7

A5  =C6*C4*C3

I need to extract the used references in formulas

For example,

for "A1", I simply need to get the C3 and C5.
for A2, I need to get the C4 and C6.
John Coleman
  • 51,337
  • 7
  • 54
  • 119
Pon
  • 315
  • 1
  • 5
  • 10

3 Answers3

6

This is an update to:

Will work for local sheet references, but not for references off-sheet. – brettdj May 14 '14 at 11:55

By Using Larrys method, just change the objRegEx.Pattern to:

(['].*?['!])?([[A-Z0-9_]+[!])?(\$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?|\$?[A-Z]+:\$?[A-Z]+|(\$?[A-Z]+\$?(\d)+))

This will:

  1. Search for optional External links: (['].*?['!])?
  2. Search for optional Sheet-reference: ([[A-Z0-9_]+[!])?
  3. Do the following steps in prioritized order:
  4. Search for ranges with row numbers (And optional $): \$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?
  5. Search for ranges without row numbers (And optional $): \$?[A-Z]+:\$?[A-Z]+
  6. Search for 1-cell references (And optional $): (\$?[A-Z]+\$?(\d)+)

Resulting in this:

Sub testing()
Dim result As Object
Dim r As Range
Dim testExpression As String
Dim objRegEx As Object

Set r = Cells(1, 2)  ' INPUT THE CELL HERE , e.g.    RANGE("A1")
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.IgnoreCase = True
objRegEx.Global = True
objRegEx.Pattern = """.*?"""  ' remove expressions
testExpression = CStr(r.Formula)
testExpression = objRegEx.Replace(testExpression, "")
objRegEx.Pattern = "(([A-Z])+(\d)+)"  'grab the address

objRegEx.Pattern = "(['].*?['!])?([[A-Z0-9_]+[!])?(\$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?|\$?[A-Z]+:\$?[A-Z]+|(\$?[A-Z]+\$?(\d)+))"
If objRegEx.test(testExpression) Then
    Set result = objRegEx.Execute(testExpression)
    If result.Count > 0 Then
        For Each Match In result
            Debug.Print Match.Value
        Next Match
    End If
End If
End Sub

Doing this, will give you the values of all possible references, I could think of. (Updated this post, because I needed the problem solved).

  • Nice. An alternative approach that might be simpler would be to use `FormulaR1C1` property since that might be easier to parse that than the default `A1` style of addressing. Your approach seems like it is in some ways superior to the approach in the accepted answer in that it is able to distinguish between absolute and relative references. On the other hand, without major modification your approach wouldn't be able to identify named ranges (which the accepted answer still picks up). A hybrid approach might be the optimal solution. – John Coleman Oct 15 '15 at 15:47
  • I tried this on a cell containing the following formula: =IF(ISBLANK('CU68X Data'!$A9),"",IF($B45&$C45&$D45&$E45='CU68X Data'!D9&'CU68X Data'!E9&'CU68X Data'!F9&'CU68X Data'!G9,'CU68X Data'!$Y9,"Condition Error")). It only returned the first reference ($A9)... how come?? – Dan May 05 '16 at 18:32
  • This line has to be changed: `'objRegEx.Pattern = """.*?""" ' remove expressions`
    Also you will have to change the Expression to the below, in order to capture your formula correctly:
    `objRegEx.Pattern = "(['].*?['!])?([[A-Z0-9_]+[!])?(\$?[A-Z]+\$?(\d)+(:\$?[A-Z]+\$?(\d)+)?|\$?[A-Z]+:\$?[A-Z]+|(\$?[A-Z]+\$?(\d)+))"`
    (Added just an "?" in the first group, to prevent this group being too greedy)
    – Michael Møldrup May 10 '16 at 11:43
  • Updated the code to reflect the above mentioned by @Dan – Michael Møldrup May 10 '16 at 11:58
  • @JohnColeman Named ranges wont work. In some cases they will: if they have both name and number i.e. "area1" will work. Named ranges should be taken care of prior to doing the regex. – Michael Møldrup May 10 '16 at 12:03
3

This function returns you a comma separated list of source cells (precedents):

Function References(rngSource As Range) As Variant
    Dim rngRef As Range
    Dim strTemp As String
    On Error Resume Next
    For Each rngRef In rngSource.Precedents.Cells
        strTemp = strTemp & ", " & rngRef.Address(False, False)
    Next
    If Len(strTemp)  0 Then strTemp = Mid(strTemp, 3)
    References = strTemp
End Function

However, please note that you cannot use this as a UDF in the worksheet, as rngRef.Address unfortunately causes a circular reference. However, you can use it in a small procedure to populate another column, e.g.

Sub ShowPrecedents()
    Dim rng As Range
    'Will paste precedents of A1:A6 into D1:D6
    For Each rng In Range("D1:D6")
        rng.Value = References(rng.Offset(, -3))
    Next
End Sub
Peter Albert
  • 16,917
  • 5
  • 64
  • 88
1

Just to provide you an alternative... NOTE THAT THIS will return duplicate result if the cells are called more than once

Sub testing()
Dim result As Object
Dim r As Range
Dim testExpression As String
Dim objRegEx As Object

Set r = Cells(1, 2)  ' INPUT THE CELL HERE , e.g.    cells("A1")
Set objRegEx = CreateObject("VBScript.RegExp")
objRegEx.IgnoreCase = True
objRegEx.Global = True
objRegEx.Pattern = """.*"""  ' remove expressions
testExpression = CStr(r.Formula)
testExpression = objRegEx.Replace(testExpression, "")
objRegEx.Pattern = "(([A-Z])+(\d)+)"  'grab the address

If objRegEx.test(testExpression) Then
    Set result = objRegEx.Execute(testExpression)
    If result.Count > 0 Then
        For Each Match In result
            Debug.Print Match.Value
        Next Match
    End If
End If
End Sub

Results are stored in "Match.Value"

Larry
  • 2,764
  • 2
  • 25
  • 36