Excel - Change cell colour based on a date in the comment or mixed in with text

Question

I am using excel 2010 and I am trying to set up a rule that will change the colour of a cell based on a date within that cell.

For example the cell may contain Site meeting - 11.05.14

I would like to be able to have it automatically change colour if it is 2 weeks away, 1 week away, 2 days away and expired.

Ideally I don't want to have a separate cell with just the date in, so possibly could the date be in the comments. I realise I am asking a lot but hopefully someone might have a solution?

I do have a solution for this but it is rough and not really what I am after. Using conditional formatting and =NOW function I can achieve the results but using two cells. I am hoping there is a way to tell excel to ignore everything in a cell before a certain symbol. In this instance "-".

Googleing has led me to VBA which unfortunately I have no idea how to use. So Hopefully someone here can help? Or at least give me a push in the right direction.

Answer 1

This does what you want

Sub WorkOutTime()

    'see http://dmcritchie.mvps.org/excel/colors.htm for colour chart

dim columnToUse as string
columnToUse = "A"    ' update this to the colum you want to use


Dim expired As Integer
expired = 3 'red

Dim twoDays As Integer
twoDays = 8 'blue

Dim sevenDays As Integer
sevenDays = 27 ' yellow

Dim fourteenDays As Integer
fourteenDays = 7 ' purple


Dim currentCell As Integer
currentCell = 1

Do While (True)

If (Range(columnToUse & currentCell).Value = "") Then
    Exit Do
End If


Dim timeNow As Date
timeNow = Date

Dim willContinue As Boolean
willContinue = True

Dim dateDifference As Integer

dateDifference = dateDiff("d", timeNow, Range(columnToUse & currentCell).Value)

If dateDifference >= 14 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = fourteenDays
    willContinue = False
End If

If dateDifference <= 7 And dateDifference > 2 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = sevenDays
End If

If dateDifference <= 2 And dateDifference >= 0 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = twoDays
End If

If dateDifference < 0 And willContinue Then
    Range(columnToUse & currentCell).Interior.ColorIndex = expired
End If

currentCell = currentCell + 1

Loop

End Sub

So, in the developer toolbar, click on Insert and click on button. Drag the shape onto the screen.

Click OK

Right click on the button and name it WorkOutTime

If you don't get the VBa screen, then click on Visual Basic from the ribbon

Delete what is in there and paste my code in.

Save as a macro enabled worksheet. Run it

Please note, my code only works for items in Column A