Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 522
  • Last Modified:

finding DirectPrecedents

how can i find all DirectPrecedents of a cell and all of the DirectPrecedents of that cell's DirectPrecedents

what i need is to collect all DirectPrecedents of a formula in excel workbook
and all of the DirectPrecedents of that cell's DirectPrecedents ( no matter how big and complex workbook is and how many sheets ) in vb runtime and add all of it to a collection or array

i am writing a VB app. that uses formulas from existing excel WB. for that if i use an excel formula i need to get ALL of its DirectPrecedents and  all of the DirectPrecedents of that formula's DirectPrecedents
i am using excel XP

thanks
0
kloppa
Asked:
kloppa
  • 9
  • 4
  • 4
  • +1
1 Solution
 
criCommented:
Manually, use Tools|Auditing

For VBA/Excel, please ask.
0
 
garethdCommented:
Kloppa,

Here are 3 VBA procedures to:
a) show all dependents
b) show all precedents
c) remove the arrows

You just need to add three buttons called "Precedents", "Dependents" and "RemoveArrows" and paste the following procedures. You may want to make the error handling more elaborate, but I am sure you get the idea.

Good Luck

garethd


Private Sub Precedents_Click()
On Error Resume Next  ' prevent error when no precedents

Dim r As Range

ActiveCell.ShowPrecedents     ' draw arrrow for first precedent

For Each r In ActiveCell.precedents      ' draw arrrow for secondary precedents
    r.ShowPrecedents
Next r

End Sub

Private Sub Dependents_Click()
On Error Resume Next  ' prevent error when no dependents

Dim r As Range

ActiveCell.ShowDependents  ' draw arrrow for first dependent

For Each r In ActiveCell.dependents   ' draw arrrow for secondary dependents
    r.ShowDependents
Next r

End Sub

Private Sub RemoveArrows_Click()
ActiveSheet.ClearArrows

End Sub
0
 
bruintjeCommented:
what about a really complex sheet with precedents into 3rd or 4th degree? i'm wondering about that since this q popped up....

:O)Bruintje
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
criCommented:
gareth, why programming buttons if you can fetch a whole toolbar in View|Toolbars|Customize|Toolbars: Auditing ? And these buttons do increment...

Additionally, ShowDependents does not work for Excel 97, for compatibility use this workaround:
Application.ExecuteExcel4Macro "TRACER.DISPLAY(FALSE,TRUE)"

kloppa, if you state what you are trying to accomplish, perhaps a better solution can be found. I happen to have a macro for cell _ranges_ (plus one to switch the beeping off...)
0
 
criCommented:
kloppa, no need to increase the points, feedback would be sufficient.
0
 
kloppaAuthor Commented:
cri, i edited my question as soon as i got your response
may be it's a better idea to post comments?
0
 
criCommented:
Yep, I did not notice it. Editing the question is for typos/grammar only, otherwise it makes the thread very difficult to follow and the experts look like they can not read.
0
 
kloppaAuthor Commented:
sorry, didn,t know
0
 
kloppaAuthor Commented:
sorry, didn,t know
0
 
garethdCommented:
Kloppa,

The precedents and dependents are already part of a collection as you can see from the the code I posted earlier:

Dim r As Range

For Each r In ActiveCell.precedents      
  r.ShowPrecedents
Next r

This returns a collection of range values and will pick up all levels (even on other workbooks)

to get the cell locations you can use:

r.address , r.column, r.row

Hope this helps

Garethd

 

0
 
kloppaAuthor Commented:
Garethd,

i can make your code to get all of the precedents (on every level) of a cell but only on the same (active) worksheet.
i dont know how to get precedents from other worksheets
any suggestions?

thanks for your help

kloppa
0
 
kloppaAuthor Commented:
Garethd,

i can make your code to get all of the precedents (on every level) of a cell but only on the same (active) worksheet.
i dont know how to get precedents from other worksheets
any suggestions?

thanks for your help

kloppa
0
 
kloppaAuthor Commented:
Garethd,

i can make your code to get all of the precedents (on every level) of a cell but only on the same (active) worksheet.
i dont know how to get precedents from other worksheets
any suggestions?

thanks for your help

kloppa
0
 
kloppaAuthor Commented:
dont know why some of my comments appear more then once

kloppa
0
 
garethdCommented:
Sorry Kloppa,

I was inaccurate when I stated that this technique would show precedents on other sheets. It shows a graohical link as I am sure you observed but the address is not returned as part of the collection.

Here is my suggestion (though I don't have time to code it all or test it , I am sure you get the idea):

1. You need an extra loop to control change in worksheet
2. At end of the inside loop (the one I already gave) you check to see if the last formula contained a reference to another sheet. If it does then you activate that sheet and perform the inner loop again.

I can spend more time on the coding later if you need it
Let me know !

Good Luck

GarethD


e.g.



Do       ' Outer Loop

Activecell.ShowPrecedents

For Each r In ActiveCell.Precedents

nextprecedent = r.address    
CellFormula = r.FormulaLocal

next r


If InStr(1, CellFormula, "!") Then
    ' code here to parse out the new sheet name AND new cell address (range) using
    ' CellFormula string and the functions Instr() and mid()  AND THEN
    ' Activate the new sheet and cell like this
 
 Worksheets(NewSheetName).Activate
 ActiveSheet.Range(NewCellAddress).Activate
FoundNewSheet = True
 
End If

loop while FoundNewSheet = true    ' outer Loop


0
 
kloppaAuthor Commented:
GarethD,

i think i need your help ( if you have some time )

thanks so much

kloppa
0
 
garethdCommented:
OK Kloppa,

Here is a complete routine (no arrow setting as I Now do not believe you need this)

This will build an array of all precedents and includes the sheetname as well as the cell location.

Hope this is what you need

Good luck

GarethD





Dim r As Range

Dim Arr_Precedent() As String           ' Dynamic Array to hold the Cell Addresses
Dim Arr_Count As Integer                ' Count Precedents (includes original cell)
Dim EndSheetName As Integer             ' MArk end of sheet in formula

Dim SaveSheet As String
Dim SaveCell As String


SaveSheet = ActiveSheet.Name
SaveCell = ActiveCell.Address


Arr_Count = 0
ReDim Arr_Precedent(1 To 1)


Do ' Outer Loop

        Arr_Count = Arr_Count + 1
        Arr_Precedent(Arr_Count) = ActiveSheet.Name & "!" & ActiveCell.Address
             
        For Each r In ActiveCell.precedents
                ' Check size of array
                Arr_Count = Arr_Count + 1
                If UBound(Arr_Precedent) < Arr_Count + 1 Then
                    ReDim Preserve Arr_Precedent(1 To Arr_Count + 3)
                End If
               
                Arr_Precedent(Arr_Count) = ActiveSheet.Name & "!" & r.Address
               
                CellFormula = r.FormulaLocal
       
        Next r
       
       
        EndSheetName = InStr(1, CellFormula, "!") 'where is the exclamation point ?
       
        If (EndSheetName) = 0 Then     '   no exclamation point so end loop
       
            FoundNewSheet = False
       
        Else
           
            ' For simplicity sake, I assume that any formula that refers to another sheet
            ' will have the reference to that sheet as the first part of the formula
           
            ' The Instr() above will have returned the position of the '!' in EndSheetName
           
           
            NewSheetName = Mid(CellFormula, 2, EndSheetName - 2)
           
            'The Cell could be either of the following forms bot must be followed
            ' ny a non numeric operator such as  *  / +  etc.
            ' An  or Ann  (eg B21 or B1)
           
            If IsNumeric(Mid(CellFormula, EndSheetName + 3, 1)) Then
                NewCellAddress = Mid(CellFormula, EndSheetName + 1, 3)
            Else
                NewCellAddress = Mid(CellFormula, EndSheetName + 1, 2)
            End If
            Worksheets(NewSheetName).Activate
            ActiveSheet.Range(NewCellAddress).Activate
           
            FoundNewSheet = True
       
        End If
Loop While FoundNewSheet = True

' Reset the Active Sheet and Cell

Worksheets(SaveSheet).Activate
ActiveSheet.Range(SaveCell).Activate
0
 
kloppaAuthor Commented:
thanks everyone.

GarethD,

i appreciate your help

kloppa
0

Featured Post

Veeam and MySQL: How to Perform Backup & Recovery

MySQL and the MariaDB variant are among the most used databases in Linux environments, and many critical applications support their data on them. Watch this recorded webinar to find out how Veeam Backup & Replication allows you to get consistent backups of MySQL databases.

  • 9
  • 4
  • 4
  • +1
Tackle projects and never again get stuck behind a technical roadblock.
Join Now