Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Different color but same color index in Excel VBA

Tags:

vba

excel-2007

I used the code below to get color index of cell in Excel.

Original Link

Function ConditionalColor(rg As Range, FormatType As String) As Long
  'Returns the color index (either font or interior) of the first cell in range rg. If no _
 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

     'Application.Volatile    'This statement required if Conditional Formatting for rg is determined by the _
    value of other cells

    Set cel = rg.Cells(1, 1)
    Select Case Left(LCase(FormatType), 1)
    Case "f" 'Font color
        ConditionalColor = cel.Font.ColorIndex
    Case Else 'Interior or highlight color
        ConditionalColor = cel.Interior.ColorIndex
    End Select

    If cel.FormatConditions.Count > 0 Then
         'On Error Resume Next
        With cel.FormatConditions
            For i = 1 To .Count 'Loop through the three possible format conditions for each cell
                frmla = .Item(i).Formula1
                If Left(frmla, 1) = "=" Then 'If "Formula Is", then evaluate if it is True
                     'Conditional Formatting is interpreted relative to the active cell. _
                    This cause the wrong results If the formula isn 't restated relative to the cell containing the _
                    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 'If "Value Is", then identify the type of comparison operator and build comparison formula
                    Select Case .Item(i).Operator
                    Case xlEqual ' = x
                        frmla = cel & "=" & .Item(i).Formula1
                    Case xlNotEqual ' <> x
                        frmla = cel & "<>" & .Item(i).Formula1
                    Case xlBetween 'x <= cel <= y
                        frmla = "AND(" & .Item(i).Formula1 & "<=" & cel & "," & cel & "<=" & .Item(i).Formula2 & ")"
                    Case xlNotBetween 'x > cel or cel > y
                        frmla = "OR(" & .Item(i).Formula1 & ">" & cel & "," & cel & ">" & .Item(i).Formula2 & ")"
                    Case xlLess ' < x
                        frmla = cel & "<" & .Item(i).Formula1
                    Case xlLessEqual ' <= x
                        frmla = cel & "<=" & .Item(i).Formula1
                    Case xlGreater ' > x
                        frmla = cel & ">" & .Item(i).Formula1
                    Case xlGreaterEqual ' >= x
                        frmla = cel & ">=" & .Item(i).Formula1
                    End Select
                    boo = Application.Evaluate(frmla) 'Evaluate the "Value Is" comparison formula
                End If

                If boo Then 'If this Format Condition is satisfied
                    On Error Resume Next
                    Select Case Left(LCase(FormatType), 1)
                    Case "f" 'Font color
                        tmp = .Item(i).Font.ColorIndex
                    Case Else 'Interior or highlight color
                        tmp = .Item(i).Interior.ColorIndex
                    End Select
                    If Err = 0 Then ConditionalColor = tmp
                    Err.Clear
                    On Error GoTo 0
                    Exit For 'Since Format Condition is satisfied, exit the inner loop
                End If
            Next i
        End With
    End If

End Function

But, as illustrated below, cells of 2 different colors give the exact same color index:

enter image description here

How to fix this error ?

I attached the test file here. Please check this error.

like image 729
dakiquang Avatar asked Sep 01 '25 03:09

dakiquang


1 Answers

Edit: My previous answer does not solve your problem, but I think it may still be relevant to someone asking the same question.

The problem you are seeing stems from the use of the Colorindex property instead of something more specific like Color.

For a thorough explanation between the two, you can refer to this address: http://msdn.microsoft.com/en-us/library/cc296089(v=office.12).aspx

Essentially, there are only 57 possible color index values, but far more available colors. The color index refers to the index in a given palette. You happened to stumble upon two colors that have the same index. To have your program function as expected, you should update colorindex references to color. Without making the change you will continue to have confusing results.


Previous answer: If you are using conditional formatting that infers the cell whose value should be applied, then when the UDF checks to determine if the conditional formatting is true it will usually defer to the current cell.

For instance, if your conditional formatting formula is something like:

=MOD(ROW(),2)=1

Every time the code hits:

frmlaR1C1 = Application.ConvertFormula(frmla, xlA1, xlR1C1, , ActiveCell)
frmlaA1 = Application.ConvertFormula(frmlaR1C1, xlR1C1, xlA1, xlAbsolute, cel)                      
boo = Application.Evaluate(frmlaA1) 

It will evaulate based upon the current active cell instead of the cell for which the conditional formatting is applied.

I did a little experimentation, but depending on how frequently you need to utilize the code I think the best result may be to enhance the formula. This would not solve all the issues, but you could try inserting the following just before the first ConvertFormula call:

frmla = Replace(frmla, "()", "(" & cel.Address & ")")

Which solves it for using Row() or Column().

If this doesn't completely solve your issue, we'll need to see your conditional formatting formulas.

like image 106
Daniel Avatar answered Sep 02 '25 19:09

Daniel