Precedents for formulas

[Bob]

Hi Everyone:

I posted this in the wrong place, and now, I am posting it here, in the
correct newsgroup. In excel VBA, is there a way to get the cell references
that a formula contains. For example, if in cell A1, I have the following
formula:

=2*B1+C3-x

where x is a defined name (referencing cell D5).

So, for cell A1, I want the program to return to me B1, C3, and x (or D5).

I would appreciate a small code for this. Thanks for all your help.

Bob

 

[ward376]

Sub way()
MsgBox Sheet1.Range("a1").Formula
End Sub

Cliff Edwards

 

[TomPl]

You didn't indicate what you wanted to do with the cell address. This code
will print them to the immediates window:

Sub Precedents()
Debug.Print ActiveSheet.Range("A1").Precedents.Address
End Sub

Tom

 

[Bob]

Hi Tom:

When I run your code as a Sub, it works fine

Sub Precedents1()
s = ActiveSheet.Range("A1").Precedents.Count
MsgBox s
End Sub
and I get 3, which is correct. However, when I run it as a function so that
I can output the result onto my spreadsheet, it does not work.

Public Function ssbb()
Call Precedents(p)
ssbb = p
End Function
Sub Precedents(p)
s = ActiveSheet.Range("A1").Precedents.Count
p = s
End Sub
Now, if on the spreadsheet, you enter the formula =ssbb() and hit return,
you get 1. And I just can't understand why. I have to get the information
in a function and not a sub.

Bob

Bob

 

[TomPl]

I don't know why this is not working in a function.
I hope someone else can answer.

Tom

 

[Bob]

That should not matter. The function returns a variant.

Hi Tom:

When I run your code as a Sub, it works fine

Sub Precedents1()
s = ActiveSheet.Range("A1").Precedents.Count
MsgBox s
End Sub
and I get 3, which is correct. However, when I run it as a function so
that I can output the result onto my spreadsheet, it does not work.

Public Function ssbb()
Call Precedents(p)
ssbb = p
End Function
Sub Precedents(p)
s = ActiveSheet.Range("A1").Precedents.Count
p = s
End Sub
Now, if on the spreadsheet, you enter the formula =ssbb() and hit return,
you get 1. And I just can't understand why. I have to get the
information in a function and not a sub.

[snipped]

In the second code example, Sub Precedents is not returning anything to
the calling function. Remember, variables (such as "p") are local to the
procedure in which they are declared (unless by chance you declared them
as global, but I doubt you did that, and you don't need to anyway).

Try

Public Function ssbb() as Long
ssbb = ActiveSheet.Range("A1").Precedents.Count
End Function

 

[Bob]

Thanks Tom. I guess, I have to ask one of the MVP's.

 

[Phillip]

Phillip London UK

Try This

Sub MyPrecedents()
Dim rng As Range
Dim s As Integer
s = ActiveSheet.Range("A1").Precedents.Count
Set rng = ActiveSheet.Range("A1").Precedents
For x = 1 To s
MsgBox rng.Areas(x).Address
Next
End Sub

 

[TomPl]

Where is an MVP when you need one?

I have tried and tried but whether I ask for the precedents count in the
function or in a called procedure from the function the count provides not
the count of precedents, but the count of cells in the range. I am guessing
that because precedents is a property and not an object, the property does
not update within a function. I'm confused. Why doesn't someone that knows
what they are talking about pay attention.

Tom

 

[Dave Peterson]

There are somethings that can't be done in a UDF if the origination is a
worksheet cell/formula. (.specialcells or changing a value in a different cell
or changing the format of any cell).

It sure looks like this is one of them.

I used this as my function:

Option Explicit
Public Function ssbb(rng As Range) As Long
Dim p As Long
Dim myPrec As Range

Set rng = rng.Cells(1)
'Set myPrec = rng.Precedents
p = rng.Precedents.Count
ssbb = p
End Function

'This worked fine
Sub aaa()
MsgBox ssbb(Activesheet.Range("a1"))
End Sub

If I tried to call the function from a formula in a cell, then I got 1--not
matter what the cell I pointed to contained--or even if it was empty.

Why does excel behave this way? I have no idea. But it does.

 

[mikerickson]

The .Precedents property only returns those precedents that are on the same sheet.
It's a bit hairy but if you select a cell and run RunMe, all the precedents of that cell, including other sheets in the same workbook and other workbooks (both open and closed) will be shown. Named ranges in the formula will be returned as their range addresses.

(The bummer is that the OP isn't going to read this. For some reason, it seems like nobody is able to read my posts. If anyone can explain why nobody can see my posts, I would appreciate it. Does PCreview automaticaly ignore posts made from a Mac?)

Speaking of which, Join is not supported on the Mac, so my function rrayStr can be replace with Join on Windows machines.

Option Explicit
Public OtherWbRefs As Collection
Public ClosedWbRefs As Collection
Public SameWbOtherSheetRefs As Collection
Public SameWbSameSheetRefs As Collection
Public CountOfClosedWb As Long
Dim headerString As String
 
Sub RunMe()
    Call FindCellPrecedents(ActiveCell)
End Sub
 
Sub FindCellPrecedents(homeCell As Range)
    Dim i As Long, j As Long, pointer As Long
    Dim maxReferences As Long
    Dim outStr As String
    Dim userInput As Long
     
    If homeCell.HasFormula Then
        Set OtherWbRefs = New Collection: CountOfClosedWb = 0
        Set SameWbOtherSheetRefs = New Collection
        Set SameWbSameSheetRefs = New Collection
         
        Rem find closed precedents from formula String
        Call FindClosedWbReferences(homeCell)
         
        Rem find Open precedents from navigate arrows
        homeCell.Parent.ClearArrows
        homeCell.ShowPrecedents
        headerString = "in re: the formula in " & homeCell.Address(, , , True)
        maxReferences = Int(Len(homeCell.Formula) / 3) + 1
On Error GoTo LoopOut:
        For j = 1 To maxReferences
            homeCell.NavigateArrow True, 1, j
            If ActiveCell.Address(, , , True) = homeCell.Address(, , , True) Then
                Rem closedRef
                Call CategorizeReference("<ClosedBook>", homeCell)
            Else
                Call CategorizeReference(ActiveCell, homeCell)
            End If
        Next j
LoopOut:
         
        On Error GoTo 0
        For j = 2 To maxReferences
            homeCell.NavigateArrow True, j, 1
            If ActiveCell.Address(, , , True) = homeCell.Address(, , , True) Then Exit For
            Call CategorizeReference(ActiveCell, homeCell)
        Next j
        homeCell.Parent.ClearArrows
         
        Rem integrate ClosedWbRefs (from parsing) With OtherWbRefs (from navigation)
        If ClosedWbRefs.Count <> CountOfClosedWb Then
            If ClosedWbRefs.Count = 0 Then
                MsgBox homeCell.Address(, , , True) & " contains a formula with no precedents."
                Exit Sub
            Else
                MsgBox "string-" & ClosedWbRefs.Count & ":nav " & CountOfClosedWb
                MsgBox "Methods find different # of closed precedents."
                End
            End If
        End If
         
        pointer = 1
        For j = 1 To OtherWbRefs.Count
            If OtherWbRefs(j) Like "<*" Then
                OtherWbRefs.Add Item:=ClosedWbRefs(pointer), key:="closed" & CStr(pointer), after:=j
                pointer = pointer + 1
                OtherWbRefs.Remove j
            End If
        Next j
         
        Rem present findings
        outStr = homeCell.Address(, , , True) & " contains a formula with:"
        outStr = outStr & vbCrLf & vbCrLf & CountOfClosedWb & " precedents in closed workbooks."
        outStr = outStr & vbCr & (OtherWbRefs.Count - CountOfClosedWb) & " precedents in other workbooks that are open."
        outStr = outStr & vbCr & SameWbOtherSheetRefs.Count & " precedents on other sheets in the same workbook."
        outStr = outStr & vbCr & SameWbSameSheetRefs.Count & " precedents on the same sheet."
        outStr = outStr & vbCrLf & vbCrLf & "YES - See details about Other Books."
        outStr = outStr & vbCr & "NO - See details about The Active Book."
        Do
            userInput = MsgBox(prompt:=outStr, Title:=headerString, Buttons:=vbYesNoCancel + vbDefaultButton3)
            Select Case userInput
            Case Is = vbYes
                MsgBox prompt:=OtherWbDetail(), Title:=headerString, Buttons:=vbOKOnly
            Case Is = vbNo
                MsgBox prompt:=SameWbDetail(), Title:=headerString, Buttons:=vbOKOnly
            End Select
        Loop Until userInput = vbCancel
    Else
        MsgBox homeCell.Address(, , , True) & vbCr & " does not contain a formula."
    End If
End Sub
 
Sub CategorizeReference(Reference As Variant, Home As Range)
    Rem assigns reference To the appropriate collection
    If TypeName(Reference) = "String" Then
        Rem String indicates reference To closed Wb
        OtherWbRefs.Add Item:=Reference, key:=CStr(OtherWbRefs.Count)
        CountOfClosedWb = CountOfClosedWb + 1
    Else
        If Home.Address(, , , True) = Reference.Address(, , , True) Then Exit Sub
        If Home.Parent.Parent.Name = Reference.Parent.Parent.Name Then
            Rem reference In same Wb
            If Home.Parent.Name = Reference.Parent.Name Then
                Rem sameWb sameSheet
                SameWbSameSheetRefs.Add Item:=Reference.Address(, , , True), key:=CStr(SameWbSameSheetRefs.Count)
            Else
                Rem sameWb Other sheet
                SameWbOtherSheetRefs.Add Item:=Reference.Address(, , , True), key:=CStr(SameWbOtherSheetRefs.Count)
            End If
        Else
            Rem reference To other Open Wb
            OtherWbRefs.Add Item:=Reference.Address(, , , True), key:=CStr(OtherWbRefs.Count)
        End If
    End If
End Sub
 
Sub FindClosedWbReferences(inRange As Range)
    Rem fills the collection With closed precedents parsed from the formula String
    Dim testString As String, returnStr As String, remnantStr As String
    testString = inRange.Formula
    testString = RemoveTextInDoubleQuotes(testString): Rem New line
    Set ClosedWbRefs = New Collection
    Do
        returnStr = NextClosedWbRefStr(testString, remnantStr)
        ClosedWbRefs.Add Item:=returnStr, key:=CStr(ClosedWbRefs.Count)
        testString = remnantStr
    Loop Until returnStr = vbNullString
     
    ClosedWbRefs.Remove ClosedWbRefs.Count
End Sub
Function NextClosedWbRefStr(ByVal formulaString As String, Optional ByRef Remnant As String) As String
    Dim testStr As String
    Dim startChr As Long
    Dim subLen As Long
    Dim i As Long
    startChr = 0
    Do
        startChr = startChr + 1
        subLen = 0
        Do
            subLen = subLen + 1
            testStr = Mid(formulaString, startChr, subLen)
            If testStr Like "'*'!*" Then
                If testStr Like "'[![]*]*'!*" Then
                    For i = 1 To 13
                        subLen = subLen - CBool(Mid(formulaString, startChr + subLen, 1) Like "[$:1-9A-Z]")
                    Next i
                    NextClosedWbRefStr = Mid(formulaString, startChr, subLen)
                    Remnant = Mid(formulaString, startChr + subLen)
                    Exit Function
                Else
                    formulaString = Left(formulaString, startChr - 1) & Mid(formulaString, startChr + subLen)
                    startChr = 0
                    subLen = Len(formulaString) + 28
                End If
            End If
        Loop Until Len(formulaString) < (subLen + startChr)
    Loop Until Len(formulaString) < startChr
End Function
 
Function OtherWbDetail() As String
    Rem display routine
    OtherWbDetail = OtherWbDetail & "There are " & OtherWbRefs.Count & " references to other workbooks. "
    OtherWbDetail = OtherWbDetail & IIf(CBool(CountOfClosedWb), CountOfClosedWb & " are closed.", vbNullString)
    OtherWbDetail = OtherWbDetail & vbCr & "They appear in the formula in this order:" & vbCrLf & vbCrLf
    OtherWbDetail = OtherWbDetail & rrayStr(OtherWbRefs, vbCr)
End Function
Function SameWbDetail() As String
    Rem display routine
    SameWbDetail = SameWbDetail & "There are " & SameWbOtherSheetRefs.Count & " ref.s to other sheets in the same book."
    SameWbDetail = SameWbDetail & vbCr & "They appear in this order, including duplications:" & vbCrLf & vbCrLf
    SameWbDetail = SameWbDetail & rrayStr(SameWbOtherSheetRefs, vbCr)
    SameWbDetail = SameWbDetail & vbCrLf & vbCrLf & "There are " & SameWbSameSheetRefs.Count & " precedents on the same sheet."
    SameWbDetail = SameWbDetail & vbCr & "They are (out of order, duplicates not noted):" & vbCrLf & vbCrLf
    SameWbDetail = SameWbDetail & rrayStr(SameWbSameSheetRefs, vbCr)
End Function
Function RemoveTextInDoubleQuotes(inString As String) As String
    Dim firstDelimiter As Long, secondDelimiter As Long
    Dim Delimiter As String: Delimiter = Chr(34)
     
    RemoveTextInDoubleQuotes = inString
    Do
        firstDelimiter = InStr(RemoveTextInDoubleQuotes & Delimiter, Delimiter)
        secondDelimiter = InStr(firstDelimiter + 1, RemoveTextInDoubleQuotes, Delimiter)
        RemoveTextInDoubleQuotes = _
        IIf(CBool(secondDelimiter), Left(RemoveTextInDoubleQuotes, firstDelimiter - 1), vbNullString) _
        & Mid(RemoveTextInDoubleQuotes, secondDelimiter + 1)
    Loop Until secondDelimiter = 0
End Function

Function rrayStr(ByVal inputRRay As Variant, Optional Delimiter As String)
    Rem display routine
    Dim xVal As Variant
    If IsEmpty(inputRRay) Then Exit Function
    If Delimiter = vbNullString Then Delimiter = " "
    For Each xVal In inputRRay
        rrayStr = rrayStr & Delimiter & xVal
    Next xVal
    rrayStr = Mid(rrayStr, Len(Delimiter) + 1)
End Function

 

[lcaretto]

A function called from a worksheet cannot change any Excel object; it can
only return a value to the cell where it is located. You cannot get around
this by calling a sub from a function on a worksheet either. Although this
is not allowed, there is no error message telling you this. The function
simply ignores commands to change Excel objects.

HTH

Larry

 

[Ron Rosenfeld]

Hi Everyone:

I posted this in the wrong place, and now, I am posting it here, in the
correct newsgroup. In excel VBA, is there a way to get the cell references
that a formula contains. For example, if in cell A1, I have the following
formula:

=2*B1+C3-x

where x is a defined name (referencing cell D5).

So, for cell A1, I want the program to return to me B1, C3, and x (or D5).

I would appreciate a small code for this. Thanks for all your help.

Bob

As you have noted, you cannot get cell references in a function using the
Precedents property.

Here is one method of parsing out the cell references from a formula. I have
not tested it extensively, and it will only work on references to the same
worksheet (as written).

Depending on what you want to do with the results, other methods might also be
applicable, and/or additions to the sPat string.

Let me know how it works for your data.

===============================
Option Explicit
Function GetRefs(rg As Range) As Variant
Dim sStr As String
Dim aRefs
Dim i As Long
Dim re As Object
Const sPat As String = "[-+/*=^&,]"

If rg.Count <> 1 Then
GetRefs = CVErr(xlErrRef)
Exit Function
ElseIf rg.HasFormula = False Then
GetRefs = CVErr(xlErrValue)
Exit Function
End If

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
sStr = re.Replace(rg.Formula, Chr(1))

aRefs = Split(sStr, Chr(1))

For i = 0 To UBound(aRefs)
On Error Resume Next
GetRefs = GetRefs & Range(aRefs(i)).Address & ", "
Next i

'remove last comma <space>
re.Pattern = ", $"
GetRefs = re.Replace(GetRefs, "")
End Function
=================================
--ron

 

[lcaretto]

Ron -- I learned some new VBA from your post. Thanks.

In trying it out I discovered that it would not return cell references in
function calls like sqrt(A1). This is easily remedied by adding a left
parenthesis to the definition of sPat giving Const sPat As String =
"[-+/*=^&,(]".

:

 

[Bob]

We are not changing anything, we are simply getting information. Besides,
if that is the case, on the spreadsheet itself, using VBA, how can I get the
number of precedence?

Bob

 

[Bob]

Yes, I did try your code, and it does NOT work. If in cell A1, you type the
formula =B1+C2+D5, and then go to cell B3 (for example), and type =ssbb()
the program returns 1 and not 3, as it should. So, something is wrong.
Please give it a try in excel 2003.

Bob

That should not matter. The function returns a variant.

Bob wrote:
Hi Tom:

When I run your code as a Sub, it works fine

Sub Precedents1()
s = ActiveSheet.Range("A1").Precedents.Count
MsgBox s
End Sub
and I get 3, which is correct. However, when I run it as a function so
that I can output the result onto my spreadsheet, it does not work.

Public Function ssbb()
Call Precedents(p)
ssbb = p
End Function
Sub Precedents(p)
s = ActiveSheet.Range("A1").Precedents.Count
p = s
End Sub
Now, if on the spreadsheet, you enter the formula =ssbb() and hit
return, you get 1. And I just can't understand why. I have to get the
information in a function and not a sub.

[snipped]

In the second code example, Sub Precedents is not returning anything to
the calling function. Remember, variables (such as "p") are local to the
procedure in which they are declared (unless by chance you declared them
as global, but I doubt you did that, and you don't need to anyway).

Try

Public Function ssbb() as Long
ssbb = ActiveSheet.Range("A1").Precedents.Count
End Function

Huh?

The function you put together will return a variant (since no data type
was specified), but it will return /no value/ because "p" is never
assigned a value in the function.

You might think "p" is assigned a value by way of Sub Precedents, and in
fact "p" does have a value in that Sub, but this is irrelevant because "p"
is a local variable, and it is /erased/ when Sub Precedents quits.

Please reread my previous post. Especially "variables (such as "p") are
local to the procedure in which they are declared". Emphasis on /local/.

If that doesn't click for you, try
http://en.wikipedia.org/wiki/Local_variable

Did you actually try my Function?

 

[Bob]

Hi Phillip:

As I mentioned earlier, the code works fine in a sub, but not in a function.
I have to use a function.

Bob

 

[Bob]

I know Dave, and you raised the same question that I initially had.
Besides, I don't think we are changing anything. We are merely getting some
information out.

Bob

 

[Bob]

Thanks Ron. It works great so far with all the stuff that I have tested.
The only problem is that it does not return named cells as their name, but
their address. However, this is relatively easy to fix (I think). Anyway,
thanks a million. At last, someone with a useful answer. Have a great
weekend.

Bob

Hi Everyone:

I posted this in the wrong place, and now, I am posting it here, in the
correct newsgroup. In excel VBA, is there a way to get the cell
references
that a formula contains. For example, if in cell A1, I have the following
formula:

=2*B1+C3-x

where x is a defined name (referencing cell D5).

So, for cell A1, I want the program to return to me B1, C3, and x (or D5).

I would appreciate a small code for this. Thanks for all your help.

Bob

As you have noted, you cannot get cell references in a function using the
Precedents property.

Here is one method of parsing out the cell references from a formula. I
have
not tested it extensively, and it will only work on references to the same
worksheet (as written).

Depending on what you want to do with the results, other methods might
also be
applicable, and/or additions to the sPat string.

Let me know how it works for your data.

===============================
Option Explicit
Function GetRefs(rg As Range) As Variant
Dim sStr As String
Dim aRefs
Dim i As Long
Dim re As Object
Const sPat As String = "[-+/*=^&,]"

If rg.Count <> 1 Then
GetRefs = CVErr(xlErrRef)
Exit Function
ElseIf rg.HasFormula = False Then
GetRefs = CVErr(xlErrValue)
Exit Function
End If

Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = sPat
sStr = re.Replace(rg.Formula, Chr(1))

aRefs = Split(sStr, Chr(1))

For i = 0 To UBound(aRefs)
On Error Resume Next
GetRefs = GetRefs & Range(aRefs(i)).Address & ", "
Next i

'remove last comma <space>
re.Pattern = ", $"
GetRefs = re.Replace(GetRefs, "")
End Function
=================================
--ron

 

[Dave Peterson]

Using .specialcells doesn't change anything in my mind, either. But it isn't
allowed in UDFs called from formulas in worksheet cells.