Removing Conditional Formatting but not the Fill Colour

M

Missile64

New member
Joined
Sep 17, 2014
Messages
2
Reaction score
0
Points
0
Hopefully I am in the right section for this question.

I have a spreadsheet that has a number of Phases and each Phase has a 'Proposed' date and 'Actual' date. I have contitionally formatted the date cells to show a traffic light system; For 'Proposed' - Green if todays date is <= Proposed date, Amber if todays date is > Proposed date and Red if todays date is 28 days > than todays date.
For 'Actual' - Green if actual date is <= proposed date, Amber if actual date is > than proposed date and Red is Actual date is 28 days > proposed date.

What I am trying to do if possible is when an 'Actual' date is entered the corrosponding 'Proposed' date conditional formatting is removed and the fill colour changed to what it was when the 'Actual' date is entered. eg in the attached spreadsheet Cell A4 would have the conditional formatting removed and the fill would be changed to Green when the 'Actual' date is entered.

Reason for wanting to do this is because eventually the 'Proposed' date under the traffic light system will all turn red.

Is this possible to do via VBA?

Hope I have explained myself clearly.

Thanks
 

Attachments

  • Conditional Formatting.xls
    15 KB · Views: 11
try this code in the sheet's own code-module:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Set myRng = Intersect(Range("B3:B6,E3:E6,H3:H6"), Target) 'you will need to adjust this.
If Not myRng Is Nothing Then
  For Each cll In myRng.Cells
    If Len(cll.Value) > 0 Then
      With cll.Offset(, -1)
        '.Select
        If .FormatConditions.Count > 0 Then
          .FormatConditions.Delete
          Select Case True
              '=AND(A3>=TODAY(),A3-TODAY()<=2400,NOT(ISBLANK(A3))):
            Case .Value >= Date And .Value - Date <= 2400 And Len(.Value) > 0
              'MsgBox "green"
              .Interior.Color = 65280

              '=AND(NOT(ISBLANK(A3)),A3<TODAY()-28):
            Case Len(.Value) > 0 And .Value < (Date - 28)
              'MsgBox "red"
              .Interior.Color = 255

              '=AND(NOT(ISBLANK(A3)),A3<TODAY()):
            Case Len(.Value) > 0 And .Value < Date
              'MsgBox "amber"
              .Interior.Color = 39423

            Case Else
              'MsgBox "blank"
              .Interior.Color = xlNone
              '.interior.Pattern = xlNone
          End Select
        End If
      End With
    End If
  Next cll
End If
End Sub
The attached includes the above code.
 

Attachments

  • ExcelGuru3519Conditional Formatting.xls
    27.5 KB · Views: 8
You must log in or register to reply here.
Back
Top