Is this possible?

[cbzdmh]

I have a finance workbook, there is a summary sheet, surprisingly called "Summary". Each Cell is a total of the the same cell for the rest of the workbooks.

For example cell A1 has a formula in it, =sum(sheet2:sheet10!A1).

What I was wondering was is if a Macro could be written so when you doubleclick on any cell, a chart or summary table appears in a user form showing the breakdown.

for example

Sheet1 - £5,000
Sheet2 - £4,000
Sheet3 - £12,000
...
..
.

Any thoughts how this could be done, if at all?

Many thanks

 

[gaj104]

If you modify the below code (sourced from http://www.ozgrid.com/forum/showthread.php?t=17028)

Sub FindPrecedents() 
    ' written by Bill Manville 
    ' With edits from PaulS 
    ' this procedure  finds the  cells which are the direct precedents of the active cell 
    Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer 
    Dim stMsg As String 
    Dim bNewArrow As Boolean 
    Application. ScreenUpdating = False 
    ActiveCell.ShowPrecedents 
    Set rLast = ActiveCell 
    iArrowNum = 1 
    iLinkNum = 1 
    bNewArrow = True 
    Do 
        Do 
            Application.Goto rLast 
            On  Error Resume Next 
            ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum 
            If Err.Number > 0 Then Exit Do 
            On Error Goto 0 
            If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do 
            bNewArrow = False 
            If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then 
                If rLast.Worksheet.Name = ActiveCell.Parent.Name Then 
                    ' local 
                    stMsg = stMsg & vbNewLine & Selection.Address 
                Else 
                    stMsg = stMsg & vbNewLine & "'" & Selection.Parent.Name & "'!" & Selection.Address 
                End If 
            Else 
                ' external 
                stMsg = stMsg & vbNewLine & Selection.Address(external:=True) 
            End If 
            iLinkNum = iLinkNum + 1  ' try another  link 
         Loop 
        If bNewArrow Then Exit Do 
        iLinkNum = 1 
        bNewArrow = True 
        iArrowNum = iArrowNum + 1  'try another arrow 
    Loop 
    rLast.Parent.ClearArrows 
    Application.Goto rLast 
     MsgBox "Precedents are" & stMsg 
    Exit Sub 
End Sub

Hope it helps

 

[cbzdmh]

WOW.

That is the most impressive and comprehensive repsonse ever!

 

[cjamen]

That is a very cool idea! I could see some great uses for that with some of my spreadsheets. Let me know how gaj104's instructions worked out for you and if you pulled it off........I might have to try too. thanks, cal

 

[cbzdmh]

It works great, i've just added selection.value where needed.