Alert by cell color change

Hi everyone,

I am looking for a macro that when the below conditions are true, then color the cell in column I light green (Standard colors).


1. If a cell in column U has a date that is older than seven days. (Ignore blank cells)
2. And if there is not a number/text in column M (Ignore when cells have a number/text)
Then color the cell in column I light green (Standard colors).

This can be either, a stand alone macro or I can add it to an existing macro.

I would rather not use conditional formatting as there are already several on the tab. Since rows are deleted and added regularly, I find it necessary to update the formulas often when using conditional formatting.

Thank you in advance.

Alvin

Hi Alvin,

Try the following Macro. I also included a Macro to get the color of the Active cell so you can change the color if you don't like my green.

Option Explicit

Sub ColorMeLightGreen()

  Const sColumnRANGE = "U:U"
  Const nLightGreenColorINDEX = 35

  Dim myRange As Range
  Dim myRangeConstants As Range
  Dim myRangeFormulas As Range
  Dim r As Range
  
  Dim myDate As Date
  Dim myTargetDate As Date
  
  Dim iRow As Long
  
  Dim sValueinColumnM As String
  Dim sValueinColumnU As String
  
  Set myRangeConstants = ActiveSheet.Range(sColumnRANGE).SpecialCells(xlCellTypeConstants)
  Set myRangeFormulas = ActiveSheet.Range(sColumnRANGE).SpecialCells(xlCellTypeFormulas)
  Set myRange = Union(myRangeConstants, myRangeFormulas)
  
  'Get the Target Date (7 days ago)
  myTargetDate = Date - 7#
  
  For Each r In myRange
    Debug.Print r.Address(False, False)
    
    'Get the value from Column U
    sValueinColumnU = r.Value
    
    'Get the row number
    'Get the value in Column M (without leading and trailing spaces)
    iRow = r.Row
    sValueinColumnM = Trim(ActiveSheet.Cells(iRow, "M").Value)
    
    'Continue only if the Value in Column 'U' is a DATE and
    'Column 'M' is BLANK
    If IsDate(sValueinColumnU) And Len(sValueinColumnM) = 0 Then
      myDate = CDate(sValueinColumnU)
      
      If myDate < myTargetDate Then
        ActiveSheet.Cells(iRow, "M").Interior.ColorIndex = nLightGreenColorINDEX
      End If
      
    End If
  Next r


End Sub

Sub GetColorOfActiveCell()
  'This will give you the 'RGB Color' and the 'ColorIndex' of the Active Cell
  
  Dim myRGB_Color As Long
  myRGB_Color = ActiveCell.Interior.Color
  MsgBox ActiveCell.Address(False, False) & " = " & LjmConvertLongToRGB(myRGB_Color) & vbCrLf & _
         "ColorIndex is " & ActiveCell.Interior.ColorIndex
  
  
End Sub

Private Function LjmConvertLongToRGB(Color As Long) As String
  'This converts an RGB long into an RGB string.
  'Note use the build in VBA function RGB(Red, Green, Blue) for the inverse
  
  Dim iBlue As Integer
  Dim iGreen As Integer
  Dim iRed As Integer
  
  iRed = Color Mod 256
  iGreen = (Color \ 256) Mod 256
  iBlue = (Color \ 256 \ 256) Mod 256
  
  LjmConvertLongToRGB = "RGB( " & Format(iRed, "@@@") & ", " & Format(iGreen, "@@@") & ", " & Format(iBlue, "@@@") & ")"
End Function

Lewis