Forum Discussion
highlighting active cells used in formulas across different worksheets/tabs
Scott-
This is actually a pretty complicated issue. I have attached the below VBA Code as well as a sample workbook that you can use to see how it works. I have modified Bill Manville's find precedent code in order to do what you require by adding in a few snippets to color the precedent cells yellow.
This is his webpage:
http://www.manville.org.uk/
In this example you must select your cell and then run the macro. I have used Sheet1!C4 as the cell to select in this example.
The Precedents are:
Sheet3!F7
Sheet3!F12
Sheet4!F5
K11
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
Dim myrng As Range
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
'This colors the local Precendent Yellow
'======================================================================
Selection.Interior.Color = vbYellow
'======================================================================
Else
stMsg = stMsg & vbNewLine & "'" & Selection.Parent.Name & "'!" & Selection.Address
'This colors the Precendent on a different worksheet Yellow
'======================================================================
Sheets(Selection.Parent.Name).Range(Selection.Address).Interior.Color = vbYellow
'======================================================================
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
In order to use the code you will need to:
1. Download the sample workbook
2. Select Cell C4 on Sheet1
3. Use key combination Alt + F11 to access the Visual Basic Editor (VBE)
4. Insert > Module
5. Paste this code to the new code module
6. Run the code by clicking the "run" button in the VBE (The little green triangle that looks like a play button)
Hope this helps!