How to highlight precedents of formula

[mkorayt]

Hi,
i wonder if there is a way to highlight the precedents of a formula,both in the same sheet and in another sheet.

Anybody can write a vb code for that?

Thanks from now i am really stucked with that :banghead:

[JimmyTheHand]

Hi mkorayt, welcome to VBAX!

What do you mean by "precedents"?
The first occurrence? Or all occurrences?

[mkorayt]

lets say in another word,

i wan't to highlight the reference cells in a formula,both in the same sheet and in another sheet.

Thanks for your interest

[JimmyTheHand]

Try the macro below. It sets a yellow background for all precedents of all formulas on the current sheet.

Sub test()
Dim c As Range
For Each c In ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 23)
c.DirectPrecedents.Interior.ColorIndex = 6
Next c
End Sub

[mkorayt]

thats great thanks...is there a way to expand the macro to cover the whole worksheets (workbook)? i tried replacing the activesheet with activeworkbook or selected sheets but not working.

[JimmyTheHand]

Well... this was a bit messy.

There might be a more elegant solution, a magic wand or something, but I could only come up with the brute force solution. Tested it with a few formulas, it worked. I'm not sure that it works with all possible formulas, though.


Sub PaintPrec()
Dim ShtCnt As Long, i As Long, j As Long, Pos As Long
Dim F As String, C As Variant
Dim SMode As String

If ActiveCell.HasFormula = False Then Exit Sub
ActiveCell.Precedents.Interior.ColorIndex = 6
F = ActiveCell.Formula
ShtCnt = Sheets.Count
For i = 1 To ShtCnt
Pos = 0
Do
Pos = InStr(Pos + 1, F, Sheets(i).Name) + Len(Sheets(i).Name) 'Look for sheet name in formula
If Pos = Len(Sheets(i).Name) Then Exit Do 'Sheet name not found in formula
SMode = "column"
For j = Pos + 1 To Len(F) + 1 'looking for cell reference, starting at "!" after the sheet name
C = Mid(F, j, 1) 'Next character of cell reference
Select Case SMode
Case "column" 'We are still at the column part of the cell reference
If IsNumeric(C) Then SMode = "row" 'row part is coming
Case "row" 'We are at the row part of the cell reference
If (Not IsNumeric(C)) Or (C = "") Then 'rowindex is over, cell address is found
C = Mid(F, Pos + 1, j - Pos - 1) 'copy the cell address that was found
Exit For
End If
End Select
Next
If C <> "" Then Sheets(i).Range(C).Interior.ColorIndex = 6 'paint it yellow
Loop
Next i
End Sub

[mkorayt]

thanks for the code...works great;you make my day :)

merry x-mas and happy new year