Assess Rows of Multiple Colors (Template) with Range of Samples and Report Results

[ProgramUser]

Hi everyone…..

Firstly, this is the Coolest Forum on the NET for VBA/Excel.....now, with that out of the way.

Please understand that I have completed exhaustive research over two weeks on my particular requirement and I have scoured the depths of the WWW, I am familiar with CPearson’s site on color use and VBA, I am familiar with this forum, forums over at Stackoverflow, exceltoxl DOT Com, Contextures, Bill Jelen (he’s an absolute Guru), ExcelIsFun and just about any other site out there that offers insight into the use of VBA and Color manipulation.

Alas….no luck!!!!!

Some of my code (some borrowed from other Authors) is below as reference.

My Rig
W8.1 Pro
Office – 2013

My Requirement
Within WS “Samples”, at Samples!$U$34:$AC$51, I have colors manually formatted into cells along numerous rows that I refer to as ‘Color Templates’, these colours are NOT part of the generic Color.INDEX, they are very specific RGB colors. Please note that there is NO CF anywhere in my project.
Then, within the same WS as above, there is a range of colors (example – $A$4:$K$10000) that are used as the ‘Sample Range’ (actually DNA sample table).
I need to compare the ‘Color Templates’ with the ‘Sample Range’. Then I need to find an exact match (if they exist) and have the results demonstrated as follows;

1. Quantity of matched rows from Sample Range (Samples!$A$4:$K$10000) with that of Color Templates copied dynamically (i.e. Application.Volatile) as the matches occur into another worksheet within same workbook called ‘POS_Match’ that shows at ;
   1. Pos_Match!$A$1 - Number of matches found and resultant as numerical value, e.g. msgBox “310 matches found.”
   2. Pos_Match!$A$3:$n$n – showing row number(s) that matches were found on.
2. Quantity of unmatched rows from Sample Range ($A$4:$K$10000) that were compared with ‘Color Templates’ (used as a cross-check)

Please note, that the colors being assessed consist of multiples as per their corresponding templates, that is to say, a template may consists of;

• At - Samples!$U$34:$AC$51 Range.Cells RGB(255,255,255 & 178,178,178 & 0,0,178 & 0,0,255)

So, I need to check several colors simultaneously and NOT just one cell. Additionally, it is important to note that the Templates never change.

Actual Color Templates consist of 17 unique colors;

• cell.Interior.Color = RGB(255, 255, 0)
• cell.Interior.Color = RGB(255, 153, 102)
• cell.Interior.Color = RGB(255, 0, 0)
• cell.Interior.Color = RGB(0, 255, 255)
• cell.Interior.Color = RGB(0, 102, 255)
• cell.Interior.Color = RGB(255, 0, 255)
• cell.Interior.Color = RGB(153, 51, 255)
• cell.Interior.Color = RGB(0, 255, 0)
• cell.Interior.Color = RGB(178, 178, 178)

Summary
So, in summary I need to match templates consisting of rows of colors with that of a large range of colors in a corresponding table.

Programmatically put, I need to check;
U34:AC34 (Template), against Sample Table Row1, then Row 2, then Row 3……Row’n’
U35:AC35 (Template), against Sample Table Row1, then Row 2, then Row 3……Row’n’
U36:AC36 (Template) against Sample Table Row1, then Row 2, then Row 3……Row’n’
….so on, and so on.
Then have the results reported into another WS as per above explanation.

‘ ************************
‘ Some of my code
Function CountRedRowsAlt(MyRange As Range) As Long
Application.Volatile
  CountRedRowsAlt = 0
  For Each R In MyRange.Rows
    For Each C In R.Cells
      If C.Interior.Color = RGB(255, 0, 0) Then
      ‘ not working yet
      'If C.Interior.Color = RGB(0, 255, 255  &  (255, 153, 102)  &  (255, 255, 0) &  (0, 102, 255)) Then
        CountRedRowsAlt = CountRedRowsAlt + 1
        Exit For
        'Exit For
      End If
    Next
    'Next
  Next
End Function
‘ ************************
‘ and…
Function CountColRngFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
 
Dim rCell As Range
Dim lCol As Long
Dim vResult
lCol = rColor.Interior.ColorIndex
    If Count = True Then
       For Each rCell In rRange
        If rCell.Interior.ColorIndex = lCol Then
                vResult = WorksheetFunction.Count(rCell) + vResult
        End If
       Next rCell
    Else
        For Each rCell In rRange
        If rCell.Interior.ColorIndex = lCol Then
                vResult = 1 + vResult
        End If
       Next rCell
End If
ColorFunction = vResult
End Function
‘ *************************

Whilst I do believe that I am now encroaching upon a full blown application in lieu of some fancy VBA, I at the very least need to give this a good shot first.

Are you guy’s able to assist me?

Thanking you very much in advance,

ProgramUser
(If you don’t ask, you don’t get!)

 

[NewOrderFac33]

Good afternoon!

I have the basis of a solution for you which I'll have to recreate at home tonight and email to you as I can't copy code from work!

Pete

 

[ProgramUser]

Okay many thanks Pete.

Regards,

ProgramUser

 

[ProgramUser]

Hey Pete,

.....been doing some thinking, and, as a side note we 'could' use the Color Index afterall if this makes coding easier.....? I feel it would be less cumbersome to just indicate;

' Color Index
Range ("A'n':A:'n') = Color.Index
Set Color.Index 
Color.Index = 3, 8, 15, 22, '(etc etc etc)

this of course is just an example.... Probably much easier than my previous approach of;

 'If C.Interior.Color = RGB(0, 255, 255  &  (255, 153, 102)  &  (255, 255, 0) &  (0, 102, 255)) Then

What are your thoughts on this Pete?

Kind regards,

ProgramUser