View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Worksheet event to change formatting when date expires.

DD,

You can use the calculate event: see code below.

HTH,
Bernie
MS Excel MVP

Private Sub Worksheet_Calculate()

Dim WatchRange As Range
Dim myC As Range

Set WatchRange = Range("D1:D1000") 'change to suit

For Each myC In WatchRange

Select Case myC.Value
Case "Pending"
'Target.Interior.ColorIndex = 5 (To Colour the single Cell)
' Target.EntireRow.Interior.ColorIndex = 36 (To Colour the entire row
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Interior.ColorIndex = 36
'(For columns A:G)
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Font.ColorIndex = 0

Case "Statement"
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Interior.ColorIndex = 34
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Font.ColorIndex = 0

Case "Closed"
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Interior.ColorIndex = 15
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Font.ColorIndex = 16

Case "Open"
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Interior.ColorIndex = 0
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Font.ColorIndex = 0

Case ""
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Interior.ColorIndex = 0
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Font.ColorIndex = 0

End Select


' =AND($G23<NOW(),$D23="Statement") - Grey fill and light blue font colour
If myC.Offset(0, 3).Value < Now And myC.Value = "Statement" Then
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Interior.ColorIndex = 15
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Font.ColorIndex = 34
End If

' =AND($G23<NOW(),$D23<"Closed") - Red font colour
' wasn't sure what background you wanted....
If myC.Offset(0, 3).Value < Now And myC.Value < "Closed" Then
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Interior.ColorIndex = 15
Range(myC.Offset(0, -3), myC.Offset(0, 3)).Font.ColorIndex = 3
End If

Next myC
Application.ScreenUpdating = True
End Sub



"DDawson" wrote in message
...
I have a macro to trigger conditional formatting events in my worksheet,
based on the cell text content in column D.

I also need an event that will update the formatting if the date in column G
is less than now, i.e. when it expires.

I have tried the following as conditional formatting, but I cannot copy the
formats down the columns, because I will lose all the existing formatting,
based on column D.

=AND($G23<NOW(),$D23="Statement") - Grey fill and light blue font colour
=AND($G23<NOW(),$D23<"Closed") - Red font colour

My existing macro is as follows; but, I doubt a change event will work,
because I am not actually changing the contents of the cells containing the
dates. Is there a way to trigger a worksheet event to update the formatting
when the date in column G expires?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim CellVal As String
If Target.Cells.Count 1 Then Exit Sub

Application.ScreenUpdating = False

'If Target = "" Then Exit Sub (See Case "")
CellVal = Target
Set WatchRange = Range("D1:D1000") 'change to suit

If Not Intersect(Target, WatchRange) Is Nothing Then
Select Case CellVal

Case "Pending"
'Target.Interior.ColorIndex = 5 (To Colour the single Cell)
' Target.EntireRow.Interior.ColorIndex = 36 (To Colour the entire row
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Interior.ColorIndex = 36
'(For columns A:G)
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Font.ColorIndex = 0

Case "Statement"
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Interior.ColorIndex = 34
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Font.ColorIndex = 0

Case "Closed"
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Interior.ColorIndex = 15
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Font.ColorIndex = 16

Case "Open"
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Interior.ColorIndex = 0
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Font.ColorIndex = 0

Case ""
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Interior.ColorIndex = 0
Range(Target.Offset(0, -3), Target.Offset(0, 3)).Font.ColorIndex = 0

End Select
End If
Application.ScreenUpdating = True
End Sub