Format cell color based on condition

[Tkeller]

I am interested in VBA code that could do the following two things to my multi worksheet workbook:


PART 1. color code cells that are used as "imports"

I would like to go through each worksheet, cell by cell, and in any cell where there is a reference to another worksheet, I would like to change the font color to blue. for example, if I am on a worksheet named "outputs" and cell B1 contians the formula =Inputs!E25, then the font for this cell should be blue. The macro should be able to change the interior color to blue

PART 2. color code cells that are used as "exports".

This is probably a bit trickier, but here what I would like to do is to go through each worksheet, cell by cell, and in any cell where the value is used as an input on another worksheet (the reverse of the above PART 1), I would like to change the font color to red. So, using the example above on the input worksheet, cell E25 should be colored red.

I realize this may be difficult to do, particularly PART 2. Any help would be greatly appreciated!

Thanks.

 

[mikerickson]

One question,
if Sheet1!A1 has the formula =Sheet2!B2 + 2
and Sheet2!B2 has the formula =Sheet3!C3 + 3

What color should Sheet2!B2 be, since it has both off-sheet precedents and dependents?

 

[Tkeller]

One question,
if Sheet1!A1 has the formula =Sheet2!B2 + 2
and Sheet2!B2 has the formula =Sheet3!C3 + 3

What color should Sheet2!B2 be, since it has both off-sheet precedents and dependents?

That is a great question and actually, this would not be allowed (as so called daisy chaining links is not allowed, per "policy") - so both cells would have to reference the same "input" cell. So, Sheet1!A1 could not have the formula = Sheet2!B2 + 2, but rather would link back to the original source and would instead be = Sheet3!C3 +5. And, then Sheet2!B2 would have the same reference in its formula = Sheet3!C3 + 3. So, per the rules:

Sheet1!A1 would be a blue cell
Sheet2!B2 would also be a blue cell and
Sheet3!C3 would be a red cell.


Thanks again.

 

[Tkeller]

So does a solution not exist or has everyone lost interest because it's such a stupid policy?

 

[mikerickson]

My idea is a brute force loop, involving .FollowArrows to test for .... (hmm, how many cells would have a "!", but not be an off sheet formula, hmm..) ... involving .FollowArrows to test for off-sheet references.

I'll get back to this after work.


(edit: Darn, the "!" might work for finding formula cells, but it won't help tell if a cell is a precedent.)

 

[Tkeller]

My idea is a brute force loop, involving .FollowArrows to test for .... (hmm, how many cells would have a "!", but not be an off sheet formula, hmm..) ... involving .FollowArrows to test for off-sheet references.

I'll get back to this after work.


(edit: Darn, the "!" might work for finding formula cells, but it won't help tell if a cell is a precedent.)

I do think just searching for the "!" would work for finding off sheet dependents. I don't think there are any cells that have a "!" unless they are text (Excel does not recognize the "!" as a factorial, which woud be the only formula useage that I am aware of).

Unfortuantely, precedence would not be as easy

Thanks for all your help!

 

[mikerickson]

I think this will do what you want.

Sub test()
    Dim oneSheet As Worksheet
    Dim oneCell As Range, RememberCurrentSelection As Range
    Dim i As Long
    Set RememberCurrentSelection = Selection
    
    For Each oneSheet In ThisWorkbook.Worksheets
        With oneSheet
            For Each oneCell In .Cells.SpecialCells(xlCellTypeFormulas)
                With oneCell
                    .Parent.ClearArrows
                    .ShowPrecedents
                    i = 1
                    
                    .NavigateArrow True, 1, i
                    If ActiveCell.Parent.Name <> .Parent.Name Then .Font.Color = vbBlue
                    Do Until ActiveCell.Parent.Name = .Parent.Name
                        Selection.Font.Color = vbRed
                        i = i + 1
                        On Error Resume Next
                        .NavigateArrow True, 1, i
                        If Err Then Exit Do
                        On Error GoTo 0
                    Loop
                End With
                Err.Clear
            Next oneCell
            .ClearArrows
        End With
    Next oneSheet
    
    Application.Goto RememberCurrentSelection
End Sub

 

[Tkeller]

This is awesome! Thank you so much - very much appreciated.

This does what I am looking for and will save me hours of work and also help me get around this stupid policy. I can not thank you enough.

I am going to go through this line by line...