Macro that will color selected cells green if they refer to other worksheet

[lifeskillz]

I am trying to create a macro that will color a selected range of cells green (or any other color for that matter) if the formula in that cell refers to a value in another worksheet.

My current macro colors a cell blue if it has a hardcoded value or black if it refers to another cell within that worksheet. I just don't know how to color the cell green if the formula refers to a cell in another worksheet.

Can anyone help? Thank you!

 

[Peter_SSs]

Try this. To implement ..

1. Right click the sheet name tab of the sheet you want coloured and choose "View Code".

2. Copy and Paste the code below into the main right hand pane that opens at step 1.

3. Close the Visual Basic window & test by making any change on the worksheet.

4. If using Excel 2007 or later your workbook will need to be saved as a macro-enabled workbook (*.xlsm)

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim cell As Range, SCF As Range, Prec As Range, Sel As Range, ActCell As Range
  Dim CI As Long, ArrowNum As Long
  Dim wsName As String
  Dim bExit As Boolean
 
  With ActiveSheet.UsedRange
    On Error Resume Next
    .SpecialCells(xlCellTypeConstants, xlNumbers).Font.ColorIndex = 5
    Set SCF = .SpecialCells(xlCellTypeFormulas)
    On Error GoTo 0
  End With
  If Not SCF Is Nothing Then
    Set Sel = Selection
    Set ActCell = ActiveCell
    ActiveSheet.ClearArrows
    Application.ScreenUpdating = False
    wsName = ActiveSheet.Name
    For Each cell In SCF
      cell.ShowPrecedents
      ArrowNum = 1
      CI = 4
      bExit = False
      Do
        On Error Resume Next
        Set Prec = cell.NavigateArrow(True, ArrowNum, 1)
        If Prec.Parent.Name <> wsName Then
          CI = 1
          bExit = True
        ElseIf Prec.Address = cell.Address Then
          If ArrowNum = 1 Then CI = 1
          bExit = True
        End If
        ArrowNum = ArrowNum + 1
      Loop Until bExit
      cell.Font.ColorIndex = CI
    Next cell
    ActiveSheet.ClearArrows
    Sel<del>ection</del>.Select
    ActCell.Activate
    Application.ScreenUpdating = True
  End If
End Sub

Note that this code is not designed to cover every possible circumstance. for example, it may/will fail if the references are to sheets in other workbooks, especially closed workbooks or if relevant sheets are hidden or protected.
So basically I've assumed we are only dealing with unprotected, visible worksheets in this one workbook.

There may also be a performance issue if you have a very large number of formulas on the worksheet.

 

[sush23]

Hi Peter,

Thank you! Im running into a problem, when I copy in the code into VBA, and chose "Macros" to run the macro, it doesn't recognize that there is a macro. I tried inputting in several sheets. Could it be because its missing a Sub (). I'm pretty new to this so I might be completely off.

Thank you so much again!
Rachel

 

[RoryA]

Peter's code is event code - it runs automatically and it must be located in the code module of the relevant worksheet.

 

[Peter_SSs]

.. and further to Rory's comment, if you follow the steps I gave at the start of post #21 then something should be happening.

In particular:

Steps 1 & 2 ensure the code is in the correct place

Step 3 Making a change on the worksheet (even if it is selecting a blank cell & hitting the Delete key) should trigger the code. After that, any time you change something on the sheet, the code should re-run itself. I did it that way because in post #18 you said ".. is there any way to turn it blue automatically without running the macro again?"


I have just noticed that I made small mistake in my code. It would not have stopped the code from running & colouring the cells, but didn't quite do what I meant at the end. If you look back to my code above, delete the red letters so that line reads

Sel.Select

 

[sush23]

Hi Peter,

Thanks for the explanation! I tried the code. The problem Im running into is that when I reference another cell in another sheet it gives me a couple arrows that point to the cell and in other cells, see attached image. Also when I try and enter (haddata after referencing a cell from another sheet, it flips to that sheet. Any Suggestions?

Thank you so much for your help and time

 

[RV_dev]

Hi,

Below VBA code will color code the font in a cell as follows (for financial modelling)

1. Formula within the selected worksheet-----------------------BLACK
2. Reference from another workbook---------------------------RED-----------------(.xlsx] - the other workbook has to be saved first)
3. Reference from another sheet within the same workbook--GREEN
4. Reference from same sheet within the same workbook-----MAROON
5. Constants/Harcoded values-----------------------------------BLUE

--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

Sub mcrFinancial_Color_Codes_Modified()
Dim rng As Range, rErr As Range
On Error Resume Next
For Each rng In Intersect(ActiveSheet.UsedRange, Selection)
If rng.HasFormula Then
Set rErr = Range(Mid(rng.Formula, 2, Len(rng.Formula) - 1))
If CBool(Err) Then
rng.Font.ColorIndex = 1 'Black
Else

If InStr(rng.Formula, ".xlsx]") Then
rng.Font.ColorIndex = 3 'Red

Else

If InStr(rng.Formula, "!") Then
rng.Font.ColorIndex = 4 'Green

Else

rng.Font.ColorIndex = 30 'Maroon
End If
End If
End If

Err = 0
ElseIf CBool(Len(rng.Value)) Then
rng.Font.ColorIndex = 5 'Blue
Else
rng.Font.ColorIndex = xlAutomatic 'default
End If
Next rng
Set rErr = Nothing
End Sub