Judd - the Excel guru!

Is it possible to access the font colour of a cell?


I have a (small)range of cells on a spread sheet and the fonts are set to Black,Red and Blue

The colours have particular meaning.

Is it possible to write a function which will return the sum of all the cells with the font set as Red?

(...and then Black and blue)

Thanks

Mark,

This little bit of code will go through a sheet and add up all of the black, blue and red cells. It only works on a sheet that has no blank cells between values. e.g

Code:

---

'this sort of format will work.
"10","20","30"
"11","12","45"


'this format won't
"10","","20"
"11",,"12"

---

I'm sure you can change it to suit your needs however. I'm not sure if the is the best way to do it either. And you may have to find out the exact value of the colours you are using.

Code:

---

Private Sub Command2_Click()
    Dim iRow As Integer, iCol As Integer
    Dim iColour As Long
    Dim iBlackSum As Integer
    Dim iRedSum As Integer
    Dim iBlueSum As Integer
   
    iRow = 1
    iCol = 1
   
    Do While myXlWB.Application.Cells(iRow, iCol).Text <> ""
      Do While myXlWB.Application.Cells(iRow, iCol).Text <> ""
''        MsgBox myXlWB.Application.Cells(iRow, iCol).Font.Color
        iColour = myXlWB.Application.Cells(iRow, iCol).Font.Color
        If iColour = 26367 Then
          'cell is red
          iRedSum = iRedSum + myXlWB.Application.Cells(iRow, iCol).Value
        ElseIf iColour = 16711680 Then
          'cell is blue
          iBlueSum = iBlueSum + myXlWB.Application.Cells(iRow, iCol).Value
        ElseIf iColour = 0 Then
          'cell is balck
          iBlackSum = iBlackSum + myXlWB.Application.Cells(iRow, iCol).Value
        End If
       
        iCol = iCol + 1
      Loop
      iRow = iRow + 1
      iCol = 1
    Loop
   
    MsgBox "Red = " & iRedSum & vbCrLf & _
          "Blue = " & iBlueSum & vbCrLf & _
          "Black = " & iBlackSum
   
End Sub

---

Hope it helps. ;)

Here's some pointers to how this can be done. You could use a Select statement to create running totals for each colour based on the value of the ColorIndex. The colour values are shown if you do a search in the help for ColorIndex.

Code:

---

Private Const SECT_COLOUR = 5
.
.
.
Dim vCell As Variant

For Each vCell In Worksheets("SHEET").Columns(1).Cells

    vCell.Select

    If vCell.Font.ColorIndex = SECT_COLOUR Then
        ' do whatever adding you want
    End If

Next

.
.
.

---

Put another post up here if you need this example expanding upon or if it's not what you want.

Hey Judd, try the following:

sub cmd1_click()
Range("A1").Select
Selection.Font.ColorIndex = 3
End Sub

This will change the colour of the font, as I am writing this on IE, I cannot check, but I dare say the MSDN site has a list of the colours and corresponding numbers, the 3 above I think was red, but try a search for "colorindex".

Secondly, try something like:

Sub cmd2_Click()
Dim x as integer
Dim cellrng
Set cellrng = Worksheets(1).Range("A1:A5")
set x = 0

cellrng.select
For each cell in cellrng
If cellrng.Font.ColorIndex = 3 then
x = x + 1
End if
Next

MsgBox"The number of Red cells is " & x
End Sub

Hope this helps !

Alex Read

That worked fine!

I modified Iain17's code into 3 seperate functions.