25+ years as a programmer, so here is how I do it. You'll need to create a VBA and put in the following code below:
Dim CI As Long
Application.Volatile True
If OfText = True Then
CI = Cell(1, 1).Font.ColorIndex
Else
CI = Cell(1, 1).Interior.ColorIndex
End If
If CI < 0 Then
If IsValidColorIndex(ColorIndex:=DefaultColorIndex) = True Then
CI = DefaultColorIndex
Else
CI = -1
End If
End If
ColorIndexOfOneCell = CI
End Function
Private Function IsValidColorIndex(ColorIndex As Long) As Boolean
Select Case ColorIndex
Case 1 To 56
IsValidColorIndex = True
Case xlColorIndexAutomatic, xlColorIndexNone
IsValidColorIndex = True
Case Else
IsValidColorIndex = False
End Select
End Function
Function ColorIndexOfRange(InRange As Range, Optional OfText As Boolean = False, Optional DefaultColorIndex As Long = -1) As Variant
Dim Arr() As Long
Dim NumRows As Long
Dim NumCols As Long
Dim RowNdx As Long
Dim ColNdx As Long
Dim CI As Long
Dim Trans As Boolean
Application.Volatile True
If InRange Is Nothing Then
ColorIndexOfRange = CVErr(xlErrRef)
Exit Function
End If
If InRange.Areas.Count > 1 Then
ColorIndexOfRange = CVErr(xlErrRef)
Exit Function
End If
If (DefaultColorIndex < -1) Or (DefaultColorIndex > 56) Then
ColorIndexOfRange = CVErr(xlErrValue)
Exit Function
End If
NumRows = InRange.Rows.Count
NumCols = InRange.Columns.Count
If (NumRows > 1) And (NumCols > 1) Then
ReDim Arr(1 To NumRows, 1 To NumCols)
For RowNdx = 1 To NumRows
For ColNdx = 1 To NumCols
CI = ColorIndexOfOneCell(Cell:=InRange(RowNdx, ColNdx), _
OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
Arr(RowNdx, ColNdx) = CI
Next ColNdx
Next RowNdx
Trans = False
ElseIf NumRows > 1 Then
ReDim Arr(1 To NumRows)
For RowNdx = 1 To NumRows
CI = ColorIndexOfOneCell(Cell:=InRange.Cells(RowNdx, 1), _
OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
Arr(RowNdx) = CI
Next RowNdx
Trans = True
Else
ReDim Arr(1 To NumCols)
For ColNdx = 1 To NumCols
CI = ColorIndexOfOneCell(Cell:=InRange.Cells(1, ColNdx), _
OfText:=OfText, DefaultColorIndex:=DefaultColorIndex)
Arr(ColNdx) = CI
Next ColNdx
Trans = False
End If
If IsObject(Application.Caller) = False Then
Trans = False
End If
If Trans = False Then
ColorIndexOfRange = Arr
Else
ColorIndexOfRange = Application.Transpose(Arr)
End If
End Function
Next, in a cell you can now for example enter in the function formula such as:
=colorIndexOfRange (A2:A2,TRUE,-1)
where the first parameter is the cell location
This will put into that cell a number which represents the color of the text in the reference cell.
For example, for the standard colors of black, blue and red in Excel, I get the numbers -1,33,3. You can then just use those numbers to add whatever potential increases to the starting values you wish.
Note: You'll have to Enable Macros every time you want to see the function, otherwise Excel won't recognize the function above (puts #NAME? as the function result)
3/13/2014 3:28 PM (edited)