VBA Conditional Formating Using Logical Expression
Hi,
In Excel2007 I have created the code below.
I am very sure this will work in Excel 2003.
Open the VBE and copy this code the the Sheet you want to control.
' begin of code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
' Savety
On Local Error GoTo Change_err
' Stop if more than 1 cell is changed
If Target.Cells.Count 1 Then Exit Sub
' Stop if changed cell is outside range2
Dim rngInter As Range
Set rngInter = Intersect(Target, Range("range2"))
If rngInter Is Nothing Then Exit Sub
' Check if changed cell is empty
If IsEmpty(Target) Then
FormatEmpty Target
Exit Sub
End If
' stop if changed cell is not numeric
If Not (IsNumeric(Target.Value)) Then
FormatNA Target
Exit Sub
End If
' Compare value of changed cell with range 1
' ------------------------------------------
' Find out row number is changed cell in range 2
Dim lngRow As Long
lngRow = Target.Row
lngRow = lngRow - Range("range2").Cells(1, 1).Row + 1
' Stop if cell in range1 is not numeric
If Not IsNumeric(Range("range1").Cells(lngRow, 1)) Then
FormatNA Target
Exit Sub
End If
' Find row corresponding value in range 1
Dim dblCompare As Double
dblCompare = Range("range1").Cells(lngRow, 1).Value
' Compare with value of changed cell
Select Case Sgn(dblCompare - Target.Value)
Case 1
' range 2 < range 1
FormatLess Target
Case 0
' range 2 = range 1
FormatEqual Target
Case -1
' range 2 range 1
FormatMore Target
End Select
' normal end of sub
Exit Sub
' error handler (safety)
Change_err:
FormatError Target
End Sub
Sub FormatLess(Target As Range)
With Target
.Interior.Color = vbBlue
With .Font
.Bold = False
.Strikethrough = False
.Color = vbYellow
End With
End With
End Sub
Sub FormatMore(Target As Range)
With Target
.Interior.Color = vbGreen
With .Font
.Bold = True
.Strikethrough = False
.Color = vbBlack
End With
End With
End Sub
Sub FormatEqual(Target As Range)
With Target
.Interior.Color = vbYellow
With .Font
.Bold = False
.Strikethrough = False
.Color = vbBlack
End With
End With
End Sub
Sub FormatNA(Target As Range)
With Target
.Interior.Color = vbBlack
With .Font
.Bold = False
.Strikethrough = True
.Color = vbWhite
End With
End With
End Sub
Sub FormatEmpty(Target As Range)
With Target
.Interior.Color = vbWhite
With .Font
.Bold = False
.Strikethrough = False
.Color = vbBlack
End With
End With
End Sub
Sub FormatError(Target As Range)
With Target
.Interior.Color = vbRed
With .Font
.Bold = True
.Strikethrough = True
.Color = vbYellow
End With
End With
End Sub
'-- end of code
HTH,
Wouter
|