View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Wouter HM Wouter HM is offline
external usenet poster
 
Posts: 99
Default 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