VBA ~ Need help with counting each code based on font color with no strikethroughs.

[DoodlesMama]

I am creating a report that analyzes pre and post occurances and need to count items based on a 4 character code, that matches a font color but has no strikethroughs. I have a matrix that I reference for the 4 character code, it's description, and last the count...for which I need the formula. The data I need to count is in another worksheet within the workbook.
Below is an example of the matrix and data.

Pre</SPAN>
CODE</SPAN>	ITEM</SPAN>	QTY</SPAN>
AACB</SPAN>	Item 1</SPAN>	0</SPAN>
AAOO</SPAN>	Item 2</SPAN>	0</SPAN>
AAQQ</SPAN>	Item 3</SPAN>	0</SPAN>
AARR</SPAN>	Item 4</SPAN>	0</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL></COLGROUP>

Post</SPAN>
CODE</SPAN>	ITEM</SPAN>	QTY</SPAN>
AACB</SPAN>	Item 1</SPAN>
AAOO</SPAN>	Item 2</SPAN>	0</SPAN>
AAQQ</SPAN>	Item 3</SPAN>	0</SPAN>
AARR</SPAN>	Item 4</SPAN>	0</SPAN>

<TBODY>
</TBODY><COLGROUP><COL><COL><COL></COLGROUP>

Code</SPAN>

AAZZ</SPAN>

AAZZ</SPAN>

<STRIKE>AAZZ</STRIKE><STRIKE></SPAN></STRIKE>

AAYY</SPAN>

<STRIKE>AAYY</STRIKE><STRIKE></SPAN></STRIKE>

<STRIKE>AAYY</STRIKE><STRIKE></SPAN></STRIKE>

AAXX</SPAN>

AATT</SPAN>

AATT</SPAN>

<STRIKE>AATT</STRIKE><STRIKE></SPAN></STRIKE>

<STRIKE>AATT</STRIKE><STRIKE></SPAN></STRIKE>

<STRIKE>AATT</STRIKE><STRIKE></SPAN></STRIKE>

<STRIKE>AATT</STRIKE><STRIKE></SPAN></STRIKE>

<STRIKE>AATT</STRIKE><STRIKE></SPAN></STRIKE>

<STRIKE>AATT</STRIKE><STRIKE></SPAN></STRIKE>

AATT</SPAN>

<STRIKE>AATT</STRIKE><STRIKE></SPAN></STRIKE>

AATT</SPAN>

AALL</SPAN>

AALL</SPAN>

<STRIKE>AALL</STRIKE><STRIKE></SPAN></STRIKE>

AALL</SPAN>

AALL</SPAN>

AALL</SPAN>

AALL</SPAN>

AALL</SPAN>

AACC</SPAN>

AACC</SPAN>

AACB</SPAN>

AACB</SPAN>

<STRIKE>AACB</STRIKE><STRIKE></SPAN></STRIKE>

AABB</SPAN>

AABB</SPAN>

<TBODY>
</TBODY><COLGROUP><COL></COLGROUP>

 

[Al Chara]

Give this UDF a try.

Function CodeCount(rCode As Range, rTable As Range) As Long


Dim rCell As Range
Dim vColor As Variant
Dim i As Integer


Application.Volatile True
vColor = rCode.Font.ColorIndex
For Each rCell In rTable
    If rCell = rCode Then
        With rCell.Font
            If .ColorIndex = vColor And .Strikethrough = False Then i = i + 1
        End With
    End If
Next rCell
CodeCount = i


End Function

If you are new to UDFs, then follow these simple steps to install the UDF.
1. Open up your workbook
2. Get into VB Editor (Press Alt+F11)
3. Insert a new module (Insert > Module)
4. Copy and Paste in your code (given above)
5. Get out of VBA (Press Alt+Q)
6. Save as a macro-enabled workbook


Here is how you would use the UDF in your spreadsheet. Note! I placed the Code list on Sheet2 cells A2:A42.

Excel 2010

	A	B	C
1	Pre
2	CODE	ITEM	QTY
3	AACB	Item 1	2
4	AAOO	Item 2	0
5	AAQQ	Item 3	0
6	AARR	Item 4	2
7	Post
8	CODE	ITEM	QTY
9	AACB	Item 1	2
10	AAOO	Item 2	2
11	AAQQ	Item 3	2
12	AARR	Item 4	0

<tbody>
</tbody>

Sheet1​

Worksheet Formulas Cell Formula C3 =codecount(A3,Sheet2!$A$2:$A$42) C4 =codecount(A4,Sheet2!$A$2:$A$42) C5 =codecount(A5,Sheet2!$A$2:$A$42) C6 =codecount(A6,Sheet2!$A$2:$A$42) C9 =codecount(A9,Sheet2!$A$2:$A$42) C10 =codecount(A10,Sheet2!$A$2:$A$42) C11 =codecount(A11,Sheet2!$A$2:$A$42) C12 =codecount(A12,Sheet2!$A$2:$A$42) <tbody> </tbody>

<tbody>
</tbody>

 

[DoodlesMama]

Thank you so much for your help Allan! It worked on the first group (red font), but gave the same counts for the second group (blue) font.
I set up the table with the first group for PRE-event counts (red font) like so:

1	A	B	C
2	CODE	DESC	QTY
3	AABB	ITEM 1	=codecount(A3,Sheet2!$U$15:$U$2212)
4	AACC	ITEM 2	=codecount(A4,Sheet2!$U$15:$U$2212)
5	AADD	ITEM 3	=codecount(A5,Sheet2!$U$15:$U$2212)

<TBODY>
</TBODY>

....and the second group for POST-event counts (blue font) like so:

1	E	F	G
2	CODE	DESC	QTY
3	AABB	ITEM 1	=codecount(E3,Sheet2!$U$15:$U$2212)
4	AACC	ITEM 2	=codecount(E4,Sheet2!$U$15:$U$2212)
5	AADD	ITEM 3	=codecount(E5,Sheet2!$U$15:$U$2212)

<TBODY>
</TBODY>

Any additional assistance you can add would be greatly appreciated!

Kind regards,
DoodlesMama

 

[Al Chara]

I set up a spreadsheet just as you described and it worked for me. Have you checked to see if Workbook Calculation is set to Automatic? Hit F9 and see if that works.

 

[DoodlesMama]

Sorry for the delay in response, I have been working on a project with a Monday deadline (tomorrow)...I FINALLY figured it out....a portion of this was done in Excel 2007 and my portion is in 2010. Although both font colors look exactly alike they were not which is why the formula did not work. I am very grateful for your assistance. Thank you so much!!

 

[Al Chara]

I'm glad you worked it out. Thanks for the feedback.