Excel - Karteireiter färben, wenn Zellfarbe rot in 2 Spalten gefunden wurde

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim myrng as Range
    Set myrng = Sh.Range("C10:C1000,F10:F1000")  
    If Not Application.Intersect(myrng, Target) Is Nothing Then
        Dim Cell As Range, found As Boolean
        For Each Cell In myrng
            If DisplayedColor(Cell, True, False) = RGB(255, 0, 0) Then
                found = True
                Exit For
            End If
        Next
        Sh.Tab.ColorIndex = IIf(found, 3, 4)
    End If
End Sub


' Funktion von hier geliehen (ermittelt die Farbe einer Zelle egal ob direkt zugewiesen oder über Bedingte Formatierung angenommen)   
' http://www.excelfox.com/forum/showthread.php/338-Get-Displayed-Cell-Color-(whether-from-Conditional-Formatting-or-not)  

Function DisplayedColor(Cell As Range, Optional CellInterior As Boolean = True, Optional ReturnColorIndex As Long = True) As Long
  Dim X As Long, Test As Boolean, CurrentCell As String
  If Cell.Count > 1 Then Err.Raise vbObjectError - 999, , "Only single cell references allowed for 1st argument."  
  CurrentCell = ActiveCell.Address
  For X = 1 To Cell.FormatConditions.Count
    With Cell.FormatConditions(X)
      If .Type = xlCellValue Then
        Select Case .Operator
          Case xlBetween:      Test = Cell.Value >= Evaluate(.Formula1) And Cell.Value <= Evaluate(.Formula2)
          Case xlNotBetween:   Test = Cell.Value <= Evaluate(.Formula1) Or Cell.Value >= Evaluate(.Formula2)
          Case xlEqual:        Test = Evaluate(.Formula1) = Cell.Value
          Case xlNotEqual:     Test = Evaluate(.Formula1) <> Cell.Value
          Case xlGreater:      Test = Cell.Value > Evaluate(.Formula1)
          Case xlLess:         Test = Cell.Value < Evaluate(.Formula1)
          Case xlGreaterEqual: Test = Cell.Value >= Evaluate(.Formula1)
          Case xlLessEqual:    Test = Cell.Value <= Evaluate(.Formula1)
        End Select
      ElseIf .Type = xlExpression Then
        Application.ScreenUpdating = False
        Cell.Select
        Test = Evaluate(.Formula1)
        Range(CurrentCell).Select
        Application.ScreenUpdating = True
      End If
      If Test Then
        If CellInterior Then
          DisplayedColor = IIf(ReturnColorIndex, .Interior.ColorIndex, .Interior.Color)
        Else
          DisplayedColor = IIf(ReturnColorIndex, .Font.ColorIndex, .Font.Color)
        End If
        Exit Function
      End If
    End With
  Next
  If CellInterior Then
    DisplayedColor = IIf(ReturnColorIndex, Cell.Interior.ColorIndex, Cell.Interior.Color)
  Else
    DisplayedColor = IIf(ReturnColorIndex, Cell.Font.ColorIndex, Cell.Font.Color)
  End If
End Function