Excel Formula - Returning a value based on Cell Color

[tvrb]

If it possible to return a value based on the color of a cell, by usin
an Excel formula? I looked at =Cell() but didn't see the option.

The cell is colored manually not using conditional formatting.

The use of this would be to sort a list based on the color of a cell.

thank

 

[Frank Kabel]

Hi
you'll VBA code for this. Have a look at
http://www.cpearson.com/excel/SortByColor.htm
http://www.cpearson.com/excel/colors.htm

for some ideas

HTH
Frank

 

[Bob Phillips]

You need to calculate the colorindex of the cells and put this in an extra
column, and sort the data with that column as the key column. Here is a
function to get the colorindex. This will work for the cell or font colour.
Call like this

=Colorindex(A1,True) 'gets text colour

=ColorIndex(A1) 'gets cell colour


'---------------------------------------------------------------------
Function ColorIndex(rng As Range, _
Optional text As Boolean = False) As Variant
'---------------------------------------------------------------------
' Function: Returns the colorindex of the supplied range
' Synopsis:
' Author: Bob Phillips/Harlan Grove
'---------------------------------------------------------------------
Dim cell As Range, row As Range
Dim i As Long, j As Long
Dim iWhite As Long, iBlack As Long
Dim aryColours As Variant

If rng.Areas.Count > 1 Then
ColorIndex = CVErr(xlErrValue)
Exit Function
End If

iWhite = WhiteColorindex(rng.Worksheet.Parent)
iBlack = BlackColorindex(rng.Worksheet.Parent)

If rng.Cells.Count = 1 Then
If text Then
aryColours = DecodeColorIndex(rng, True, iBlack)
Else
aryColours = DecodeColorIndex(rng, False, iWhite)
End If

Else
aryColours = rng.Value
i = 0

For Each row In rng.Rows
i = i + 1
j = 0

For Each cell In row.Cells
j = j + 1

If text Then
aryColours(i, j) = DecodeColorIndex(cell, True, iBlack)
Else
aryColours(i, j) = DecodeColorIndex(cell, False, iWhite)
End If

Next cell

Next row

End If

ColorIndex = aryColours

End Function

'---------------------------------------------------------------------
Private Function WhiteColorindex(oWB As Workbook)
'---------------------------------------------------------------------
Dim iPalette As Long
WhiteColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &HFFFFFF Then
WhiteColorindex = iPalette
Exit Function
End If
Next iPalette
End Function

'---------------------------------------------------------------------
Private Function BlackColorindex(oWB As Workbook)
'---------------------------------------------------------------------
Dim iPalette As Long
BlackColorindex = 0
For iPalette = 1 To 56
If oWB.Colors(iPalette) = &H0 Then
BlackColorindex = iPalette
Exit Function
End If
Next iPalette
End Function

'---------------------------------------------------------------------
Private Function DecodeColorIndex(rng As Range, text As Boolean, idx As
Long)
'---------------------------------------------------------------------
Dim iColor As Long
If text Then
iColor = rng.font.ColorIndex
Else
iColor = rng.Interior.ColorIndex
End If
If iColor < 0 Then
iColor = idx
End If
DecodeColorIndex = iColor
End Function

'---------------------------------------------------------------------
' End of ColorIndex
'---------------------------------------------------------------------



--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Peter Atherton]

Two macros will do the job. the result will appear in the
next column. A1 colour will be presented as a number in B2.
Change the offset value to make sure that the result are
given in a blank column.
The cell font colour:

Sub getColorFont()
Dim c
Dim x As Integer
For Each c In Selection
x = c.Font.ColorIndex
c.Offset(0, 1) = x
Next c
End Sub

The cell Background colour;
Sub getColorFill()
Dim c
Dim x As Integer
For Each c In Selection
c.Select
x = c.Interior.ColorIndex
c.Offset(0, 1) = x
Next c
End Sub

 

[Peter atherton]

A variation of the last post will work on a block of cells.

Sub getColorFont()
Dim c, nr As Long
Dim x As Integer, nc As Integer
nc = Selection.Columns.Count
For Each c In Selection
x = c.Font.ColorIndex
c.Offset(0, nc + 1) = x
Next c
End Sub

Sub getColorFill()
Dim c
Dim x As Integer, nc As Integer
nc = Selection.Columns.Count
For Each c In Selection
c.Select
x = c.Interior.ColorIndex
c.Offset(0, nc + 1) = x
Next c
End Sub

Regards
Peter