Solved: Splitting all addresses in a formula

[brettdj]

Have you considered the path of using regular expressions to find cell references by the form of a formula.
1) Develop the rules needed to determine if a formula is well formed (eg. if "=A" and "=B" are well formed formulas, then "=A+B", "=A-B", "=A*B" and "=A/B" are also wff's)
2) Work backwards from those rules to determine the "atomic" portions of a specific formula.
3) Determine which of those are cell references (vs. constants).

see my earlier post on this.

cheers

dave

[Bob Phillips]

see my earlier post on this.

cheers

dave

Dave, can you check your PMs, Bob

[mikerickson]

I think this will do it. The sub RunMe will return the addresses of all precedents of the ActiveCell.

Open or closed workbook, named ranges are also returned.
After FindCellPrecedents is run, the collections are filled with addresses of all the cell's precedents.
The OtherWbRefs are in order that they appear in the formula. It also includes the precedents that are in closed workbooks.
SameWbOtherSheetRefs is also in order of the formula.

Someone with a scripting dictionary might want to change the coding in NextClosedWbRefStr.

I think this will do what you want.
[VBA]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
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(FormulaString As String, Optional ByRef Remnant As String) As String
Dim workStr As String
Dim start As Long, interval As Long, del As Long
For start = 1 To Len(FormulaString)
For interval = 2 To Len(FormulaString) - start + 1
workStr = Mid(FormulaString, start, interval)
If workStr Like Chr(39) & "[!!]*'![$A-Z]*#" Then
If workStr Like Chr(39) & "[!!]*'!*[$1-9A-Z]#" Then
interval = interval - CLng(Mid(FormulaString, start + interval, 1) Like "#")
interval = interval - 3 * CLng(Mid(FormulaString, start + interval, 1) = ":")
interval = interval - CLng(Mid(FormulaString, start + interval, 1) Like "[$1-9A-Z]")
interval = interval - CLng(Mid(FormulaString, start + interval, 1) Like "[$1-9A-Z]")
interval = interval - CLng(Mid(FormulaString, start + interval, 1) Like "[$1-9A-Z]")
interval = interval - CLng(Mid(FormulaString, start + interval, 1) Like "[$1-9A-Z]")
NextClosedWbRefStr = Mid(FormulaString, start, interval)
Remnant = Mid(FormulaString, start + interval)
Exit Function
End If
End If
Next interval
Next start
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 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
[/VBA]

[xluser2007]

Hi mike,

Firstly, apologies for my delayed response, was busy with work yesterday so am responding with first opportunity today.

Secondly, before I discuss the awesome algorithm that you have supplied, can I just thank you and other contributors on VBAX who are helping me learn and develop through your superb and generous help . On this steep learning curve, I really appreciate it.

The code you ahve sent me is brilliant, and have tested it for an externally linked workbook. To give details, I tested it on a linked workbook I posted here for a previous query to Bob titled C:\VBAX_Test_workbookforxld.xls. It has 3 worksheets ('Ext Links 1', 'Ext Links 2', 'Ext Links 3').

I tried the following testing (in 'Ext Links 1' worksheet):

• An internal link in the same worksheet.

• Cell 014 formula "=013"
• Sub Run me output:
  • '[VBAX_Test_workbookforxld.xls]Ext Links 1'$0$13, as required.
  • FOUND CORRECTLY

• An internal link in a different worksheet in the same workbook

• Cell Q20 formula "='Ext Links 2'!F32"
• Sub Run me output:
  • Msgbox OKonly style "Methods find different # of closed precedents"
  • FOUND INCORRECTLY i.e. no link found.

• An external link of an already open workbook

• Cell P14 formula "='[Test with Notes.xls]TestData'!D22"
• Sub Run me output:
  • Msgbox OKonly style "Methods find different # of closed precedents"
  • FOUND INCORRECTLY i.e. no link found.

• An external link of a closed workbook

• Cell M9 formula "='C:\[sumif_countif.xls]Sheet1'!M8"
• Sub Run me output:
  • 'C:\[sumif_countif.xls]Sheet1'!M9, as required.
  • FOUND CORRECTLY
  • However sometimes when there is a single closed workbook link, the output errs and gives the same VBOkOnly Msgbox as with the p[revious test i.e. "Methods find different # of closed precedents", I can;t understand why it would do this for some cells and not others?

When used in combination of open closed, internal links (i.e. a more realistic scenario e.g. cell formula is "=M8+D4+'C:\[sumif_countif.xls]Sheet1'!K9", the macro gives the same VBOkOnly Msgbox as above.

Did you find this when you tested it?

• If not, could you please explain what I may be doing wrong?
• If so, could you kindly help me to amend for it?

Again thank you for your help and patience. Despite my efforts on this problem, I realise its quite advanced but am learning lots in the process.

Please let me know on the above.

regards.

[mikerickson]

The posted routine confuses references to a worksheet with a space (eg.='My Sheet'!A1) with a reference to a closed workbook (='Macintosh HD:Users:merickson: Desktop:[Workbook3.xls]Sheet1'!$C14) (space inserted before "Desktop" to prevent emoticon )

("When did some nit-wit in a suit decide that spaces in sheet names were OK?", the old school grumbles.)

Changing this UDF will fix that.

The faulty result in the mixed case may be related to spaces in worksheet names. If so, this fix should include that as well.
The new routine correctly returned the precedents from
=Sheet2!B21+B21+'Macintosh HD:Users:merickson: Desktop:[Workbook2.xls]Sheet1'!$B$4+'Sh 3'!A3

ALSO: A remove-everything-between-double-quotes routine needs to be incorporated so that the text function
="xyz'[MyBook]mySheet'!A3abc" is not mis-read as a cell refernece.
I'll get on that when I get back from the post-event hot springs meeting.

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

This function is the part of my code that is particularly suited to the use of Regular Expressions. (Parsing equations is the genesis of Regular Languages.) I wish my Mac supported them.

[xluser2007]

The posted routine confuses references to a worksheet with a space (eg.='My Sheet'!A1) with a reference to a closed workbook (='Macintosh HD:Users:merickson: Desktop:[Workbook3.xls]Sheet1'!$C14) (space inserted before "Desktop" to prevent emoticon )

Nice pick-up, may I ask how you realised this from my testing above?

The code works really well now mike .

ALSO: A remove-everything-between-double-quotes routine needs to be incorporated so that the text function
="xyz'[MyBook]mySheet'!A3abc" is not mis-read as a cell refernece.

This sounds interesting. I look forward to seeing your code for this and seeing a final solution to this interesting parsing problem. This problem is proving to be an enriching VBA experience, with all these conditions that keep popping up.

This function is the part of my code that is particularly suited to the use of Regular Expressions. (Parsing equations is the genesis of Regular Languages.) I wish my Mac supported them.

Since Bob and Dave mentioned this in an earlier post I have been intrigued by the pwer of RegExp. I feel I have only skimmed my understanding of its usefulness. The site I have been using is: http://www.regular-expressions.info/.

If I knew this better for use in VBA, I would love to adapt my initial attempt to using it. But other than Dave's great example list, there are not any great online tutorials for application in VBA, juts a case of trial-and-error to learn (which can be fun!)

BTW, I know my earlier code may is not as robust as yours, but for finding closed links in external workbooks, could you fault my code titled "Find_External_Links_in_CLOSED_Workbooks_references_only", I found that this bit worked quite well. If you can break it, is there a way to amend this code using RegExp to make it more rigorous, I'm just curious to hear your thoughts.

Well, thanks again and please let me know of the other Function and any changes.

regards,

[mikerickson]

How did I know from your test data?

"='C:\[sumif_countif.xls]Sheet1'!M8" - closed precedent CORRECT

"='[Test with Notes.xls]TestData'!D22" - open other wb ERROR
"='Ext Links 2'!F32" - same wb other sheet ERROR

The string parsing routine Post #29 defined a "reference to a closed workbook" as any sub-string that begins with the pattern ' (anything) '![VBA]testString Like " '*"!' " : Rem spaces added for clarity[/VBA]The two failed cases both involved sheet names with spaces, which has a syntax that matches that definintion.
To exclude that situation, the post #31 correction "defines" a "reference to a closed workbook" as any sub-string that
begins with ' (anything) ] (anything) '![VBA]testString Like " '*]*"!' " : Rem spaces added for clarity[/VBA]

It turns out that that is not specific enough. The correction below defines "external reference" as any sub-string that begins with
apostrophy (required, any character except [) (anything) ] (anything) '!
[VBA]If testStr Like "'[![]*]*'!*" Then[/VBA]

In addition, the new function RemoveTextBetweenDoubleQuotes has been added.

These two routines should be replaced.[VBA]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
[/VBA]
And this new function added.
[VBA]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
[/VBA]
All this string maniputlation can be improved. Windows supports better string handling features like Regular Expressions, Split, Join, Replace than Mac does.

I'm also wondering what this is for. Is there an end use for this or is it an intellectual exersize at the moment?