Function ConditionalColor(rg As Range, FormatType As String) As Long
conditional format conditions apply, Then returns the regular color of the cell. _
FormatType Is either "Font" Or "Interior"
Dim cel As Range
Dim tmp As Variant
Dim boo As Boolean
Dim frmla As String, frmlaR1C1 As String, frmlaA1 As String
Dim i As Long
value of other cells
Set cel = rg.Cells(1, 1)
Select Case Left(LCase(FormatType), 1)
Case "f"
ConditionalColor = cel.Font.ColorIndex
Case Else
ConditionalColor = cel.Interior.ColorIndex
End Select
If cel.FormatConditions.Count > 0 Then
With cel.FormatConditions
For i = 1 To .Count
frmla = .Item(i).Formula1
If Left(frmla, 1) = "=" Then
This cause the wrong results If the formula isn
Conditional Formatting--hence the workaround using ConvertFormula twice In a row. _
If the Function were Not called using a worksheet formula, you could just activate the cell instead.
frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)
boo = Application.Evaluate(frmlaA1)
Else
Select Case .Item(i).Operator
Case xlEqual
frmla = cel & "=" & .Item(i).Formula1
Case xlNotEqual
frmla = cel & "<>" & .Item(i).Formula1
Case xlBetween
frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
Case xlNotBetween
frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
Case xlLess
frmla = cel & "<" & .Item(i).Formula1
Case xlLessEqual
frmla = cel & "<=" & .Item(i).Formula1
Case xlGreater
frmla = cel & ">" & .Item(i).Formula1
Case xlGreaterEqual
frmla = cel & ">=" & .Item(i).Formula1
End Select
boo = Application.Evaluate(frmla)
End If
If boo Then
On Error Resume Next
Select Case Left(LCase(FormatType), 1)
Case "f"
tmp = .Item(i).Font.ColorIndex
Case Else
tmp = .Item(i).Interior.ColorIndex
End Select
If Err = 0 Then ConditionalColor = tmp
Err.Clear
On Error GoTo 0
Exit For
End If
Next i
End With
End If
End Function
Sub NonConditionalFormatting()
Dim cel As Range
Application.ScreenUpdating = False
For Each cel In Selection
If cel.FormatConditions.Count > 0 Then
cel.Interior.ColorIndex = ConditionalColor(cel, "Interior")
cel.Font.ColorIndex = ConditionalColor(cel, "Font")
cel.FormatConditions.Delete
End If
Next cel
Application.ScreenUpdating = True
End Sub
|