Solved: Conditionally changing a cell's font colour with a function

[CSW]

I'm no programmer, but I need to get a job done.

I'm trying to build a function which takes two values, let's call them A and B, and if A < B then change the font colour of that cell to red.

This is what I've got (which obviously doesn't work and that's why I'm here):


Function cell_colour(number, threshold)
' Changes font colour of the number if it is less than the given threshold.
' This function is designed mainly to highlight losses in red.

current_cell_row = ActiveCell.Row
current_cell_column = ActiveCell.Column

If number < threshold Then
ActiveWorkbook.ActiveSheet.Range(current_cell_row, current_cell_column).Font.Color = RGB(255, 0, 0)
End If

' Return value that the cell should contain
cell_colour = number

End Function


I typed in =cell_colour(-1,0) in a random cell and I get #VALUE! (in black) back. Can any of you wise experts shred any light on the problem?

[Simon Lloyd]

A function can't change anything, it can however produce a value, you need to return that value to a sub to chnage your colours.

[CSW]

Thanks for the prompt reply.

I'm actually not too clear about the difference between a function and a sub. I tried writing a sub and then calling it like a function from a cell ( =cell_colour(-1,0) ) and that doesn't work.

If I use a sub instead, how do I trigger it?

[CSW]

For the benefit of others, I've partially solved my issue after hours of googling and good old trial and error. Code as follow:


Sub cell_format_execute(calling_cell_row, calling_cell_column, action_code)
' Changes the formating of a given cell based on the given action_code
' This sub is called by the function cell_format
' code 0 = black text no underline
' code 1 = red text no underline
' code 2 = red text with underline

If action_code = 0 Then
Cells(calling_cell_row, calling_cell_column).Font.Color = RGB(0, 0, 0)
ElseIf action_code = 1 Then
Cells(calling_cell_row, calling_cell_column).Font.Color = RGB(255, 0, 0)
ElseIf action_code = 2 Then
Cells(calling_cell_row, calling_cell_column).Font.Color = RGB(255, 0, 0)
Cells(calling_cell_row, calling_cell_column).Font.Underline = xlUnderlineStyleSingle ' DOES NOT WORK!!!
End If

End Sub

---------------------------------------------------------------

Function cell_format(number, threshold1, threshold2)
' Given a number, this function will pass on the coordinate of the calling cell and
' an action code to the Sub cell_format_execute. The action code is determined by
' a pair of user-defined thresholds
'
' i.e. =cell_format(some_number, 0, -1)
'
' if some_number is bigger than 0 then code 0 will be passed on
' if some_number is smaller than or equal to 0 then code 1 will be passed on
' if some_number is smaller than or equal to -1 then code 2 will be passed on

' Get calling cell location
calling_cell_row = Application.Caller.Row
calling_cell_column = Application.Caller.Column

If threshold2 > threhold1 Then
'return error message and exit
cell_format = "check cell_format function - T2 > T1"
Exit Function
ElseIf number <= threshold2 Then
action_code = 2
ElseIf number <= threshold1 Then
action_code = 1
Else
action_code = 0
End If

Call cell_format_execute(calling_cell_row, calling_cell_column, action_code)


' Return input number back to the cell
cell_format = number

End Function





My next issue is, underlining does not work, even though it's straight out of this reference from Microsoft:

msdn.microsoft.com/en-us/library/bb221937.aspx

The font colour changing works perfectly though [EDIT: only in Excel 2007 but not 2003. Why?]. I'd appreciate any wisdom on the underlining issue.

[georgiboy]

If say your A data is in column A and your B data is in column B.

You could have a function like...
Function ChangeColour(aCell As Range, bCell As Range)
Dim Colour As Long

If aCell.Value < bCell.Value Then
ChangeColour = "Less than"
Colour = 3
ElseIf aCell.Value = "" Or bCell.Value = "" Then
ChangeColour = ""
Colour = 1
ElseIf aCell.Value = bCell.Value Then
ChangeColour = "Equal"
Colour = 5
Else
ChangeColour = "Greater"
Colour = 4
End If

With bCell.Offset(, 1).Font
.ColorIndex = Colour
End With

End Function
to place text and format the cell.

Hope this helps

[mikerickson]

Here's a UDF based solution.

Put this in a normal modulePublic CellsToChange As New Collection
Public CellsToClear As New Collection

Function MakeCellRed() As Boolean
Application.Volatile
On Error Resume Next
With Application.Caller
CellsToChange.Add Item:=.Cells, key:=.Address(, , , True)
End With
On Error GoTo 0
MakeCellRed = True
End Function
and this in the ThisWorkbook code modulePrivate Sub Workbook_SheetCalculate(ByVal Sh As Object)
Dim oneCell As Range
For Each oneCell In CellsToClear
oneCell.Font.ColorIndex = xlAutomatic
Next oneCell
Set CellsToClear = Nothing
For Each oneCell In CellsToChange
With oneCell
.Font.ColorIndex = 3
On Error Resume Next
CellsToClear.Add Item:=.Cells, key:=.Address(, , , True)
On Error GoTo 0
End With
Next oneCell
Set CellsToChange = Nothing
End SubThen putting =IF(A1<B1,TurnCellRed(),"something") will allow the values of A1 and B1 control the font color of the cell holding the formula.

Using Conditional Formatting would be easier.

[CSW]

Thanks I'll have a look at these tonight.

Further to what I posted previously I found out my code only worked in Excel 2007 but NOT 2003.

[EDIT] Ahhh... yes. I did not know about Conditional Formating. Still, it was a good programming exercise.

[mdmackillop]

I'm actually not too clear about the difference between a function and a sub.
A function returns a value =SUM(A1:B1). It can only put a result in the cell(s) in which it is entered.
This sample will add two cells. If you remove the apostophe, the code looks valid, but will fail.


Function Test(Data1 As Range, Data2 As Range)
Test = Data1 + Data2
'Data2.Offset(, 2) = Data2 + 2
End Function