BAD : Matching and auto highlight matched cell answers with colours

[Mindee]

Hi Hi,
To someone that can safe me.

I need to do up a formulated worksheet.
Lets say Cell A1(Red colour cell)
and Cell A2(Blue colour cell)
and Cell A3(Green colour cell)
and Cell A4,B4,C4,D4,E4,F4,G4(Yellow colour cell)
and Cell A5,B5,C5,D5,E5,F5,G5(Orange colour cell)
These cells above will be key in with numbers.(numbers that i need t
find)

Column A to J row 8 to 500, will have thousands over numbers keyed i
earlier.(numbers to be lookup)

Now i need help in this, If those numbers to be lookup matches wit
those key in above, that cell should change colour accordingly. And os
able to give me an auto tabulate numbers of colour strike.
Lets say "1000Red,500Blue,450Green,890Yellow,300Orange)

Thank you for you help!
I really need this help.
Thank you a million, and may god bless this someone sweet and helpful.

minde

 

[Frank Kabel]

Hi
for the second part of your question (summing colored cells) you may
use the following:

-----
using a procedure from Bob Phillips and Harlan Grove you may try the
following:

=SUMPRODUCT(--(ColorIndex(A1:A100)=3))
to count all red cells (background color) within the range A1:A100

or
=SUMPRODUCT(--(ColorIndex(A1:A100,TRUE)=3))
to count all red cells (font color) within the range A1:A100

To get the colorindex of a specific cell use
=ColorIndex(A1)

Adapt this to your requirements

------
'Code to paste in one of your modules

'---------------------------------------------------------------------
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

 

[Medemper]

I'm sure there is a much easier/cleaner way to do this but:

Sub ColorizeCountAndSum()
Dim SumA1, SumA2, SumA3, SumA4, SumA5 As Integer
Dim CountA1, CountA2, CountA3, CountA4, CountA5 As Integer
SumA1 = 0
SumA2 = 0
SumA3 = 0
SumA4 = 0
SumA5 = 0
CountA1 = 0
CountA2 = 0
CountA3 = 0
CountA4 = 0
CountA5 = 0

For i = 1 To Range("A8:j" & Range("a8").End(xlDown).Row).Columns.Count
Cells(8, i).Select
For j = 1 To Range("A8:j" & Range("a8").End(xlDown).Row).Rows.Count
Select Case ActiveCell.Value
Case Range("a1").Value
ActiveCell.Interior.Color = Range("a1").Interior.Color
SumA1 = SumA1 + ActiveCell.Value
CountA1 = CountA1 + 1
Case Range("a2").Value
ActiveCell.Interior.Color = Range("a2").Interior.Color
SumA2 = SumA2 + ActiveCell.Value
CountA2 = CountA2 + 1
Case Range("a3").Value
ActiveCell.Interior.Color = Range("a3").Interior.Color
SumA3 = SumA3 + ActiveCell.Value
CountA3 = CountA3 + 1
Case Range("a4").Value, Range("b4").Value, Range("c4").Value, Range("d4").Value, Range("e4").Value, Range("f4").Value, Range("g4").Value
ActiveCell.Interior.Color = Range("a4").Interior.Color
SumA4 = SumA4 + ActiveCell.Value
CountA4 = CountA4 + 1
Case Range("a5").Value, Range("b5").Value, Range("c5").Value, Range("d5").Value, Range("e5").Value, Range("f5").Value, Range("g5").Value
ActiveCell.Interior.Color = Range("a5").Interior.Color
SumA5 = SumA5 + ActiveCell.Value
CountA5 = CountA5 + 1
Case Else
End Select
ActiveCell.Offset(1, 0).Select
Next j
Next i

ActiveCell.Offset(2, -9).Value = "SumA1 = " & SumA1
ActiveCell.Offset(2, -9).Interior.Color = Range("a1").Interior.Color
ActiveCell.Offset(3, -9).Value = "SumA2 = " & SumA2
ActiveCell.Offset(3, -9).Interior.Color = Range("a2").Interior.Color
ActiveCell.Offset(4, -9).Value = "SumA3 = " & SumA3
ActiveCell.Offset(4, -9).Interior.Color = Range("a3").Interior.Color
ActiveCell.Offset(5, -9).Value = "SumA4 = " & SumA4
ActiveCell.Offset(5, -9).Interior.Color = Range("a4").Interior.Color
ActiveCell.Offset(6, -9).Value = "SumA5 = " & SumA5
ActiveCell.Offset(6, -9).Interior.Color = Range("a5").Interior.Color

ActiveCell.Offset(2, -6).Value = "CountA1 = " & CountA1
ActiveCell.Offset(2, -6).Interior.Color = Range("a1").Interior.Color
ActiveCell.Offset(3, -6).Value = "CountA2 = " & CountA2
ActiveCell.Offset(3, -6).Interior.Color = Range("a2").Interior.Color
ActiveCell.Offset(4, -6).Value = "CountA3 = " & CountA3
ActiveCell.Offset(4, -6).Interior.Color = Range("a3").Interior.Color
ActiveCell.Offset(5, -6).Value = "CountA4 = " & CountA4
ActiveCell.Offset(5, -6).Interior.Color = Range("a4").Interior.Color
ActiveCell.Offset(6, -6).Value = "CountA5 = " & CountA5
ActiveCell.Offset(6, -6).Interior.Color = Range("a5").Interior.Color

Range("a8").Select
End Sub

Good luck
Hi Hi,
To someone that can safe me.

I need to do up a formulated worksheet.
Lets say Cell A1(Red colour cell)
and Cell A2(Blue colour cell)
and Cell A3(Green colour cell)
and Cell A4,B4,C4,D4,E4,F4,G4(Yellow colour cell)
and Cell A5,B5,C5,D5,E5,F5,G5(Orange colour cell)
These cells above will be key in with numbers.(numbers that i need to
find)

Column A to J row 8 to 500, will have thousands over numbers keyed in
earlier.(numbers to be lookup)

Now i need help in this, If those numbers to be lookup matches with
those key in above, that cell should change colour accordingly. And oso
able to give me an auto tabulate numbers of colour strike.
Lets say "1000Red,500Blue,450Green,890Yellow,300Orange)

Thank you for you help!
I really need this help.
Thank you a million, and may god bless this someone sweet and helpful.

mindee