Need a MsgBox if a Date in a Range is 30 Days Old

[mrgillus]

I attached the sheet in which I would like this to apply, particularly because it already contains some code under the Sub Worksheet_Calculate() and I wanted to make sure it got merged with this new code ok.

Basically I just want a macro to Check M2:M2000 and see if any of the dates that appear there are older than 30 days. If they are then I would like it to put up a MsgBox displaying any overdue CARs and would like the msgbox to display the CAR # in column A associated with the overdue date in Column M.

For example, looking at the attached sheet- the msgbox would pop up when the user selects the log sheet and it would say:

"Todays Date is 8/28/2009
CAR # 236 was due on 7/26/2009 and is now overdue!
CAR # 239 was due on 7/24/2009 and is now overdue!"

and then the user would click "ok" to get out of the msgbox

I appreciate the help!

Private Sub Worksheet_Calculate()
    Dim cell        As Range

    For Each cell In Intersect(Me.UsedRange, Range("CY2:CY2000"))
        Select Case cell.Value
            Case Empty
                cell.Interior.ColorIndex = xlColorIndexNone
            Case "Pending Approval"
                cell.Interior.ColorIndex = 38
            Case "Open"
                cell.Interior.ColorIndex = 45
            Case "Pending Close"
                cell.Interior.ColorIndex = 6
            Case "Closed"
                cell.Interior.ColorIndex = 35
        End Select
    Next cell
End Sub

[mrgillus]

Here is the attachment.. sorry forgot it

[Leith Ross]

Hello mrgillus,

The following macro has been added to "Sheet1" to run the macro. Each over due date found is first displayed in a message box and copied to the sheet with the CAR number and the due date.

Sub CheckDates()

  Dim Cell As Range
  Dim DueDate As Variant
  Dim Dst As Range
  Dim DstWks As Worksheet
  Dim LogWks As Worksheet
  Dim NextRow As Long
  Dim Rng As Range
  Dim RngEnd As Range
  
    Set DstWks = Worksheets("Sheet1")
    Set LogWks = Worksheets("Log")
    
    Set Dst = DstWks.Range("A1")
    Set RngEnd = DstWks.Cells(Rows.Count, Dst.Column).End(xlUp)
    Set Dst = DstWks.Range(Dst, RngEnd)
    
    Set Rng = LogWks.Range("A2")
    Set RngEnd = LogWks.Cells(Rows.Count, Rng.Column).End(xlUp)
    Set Rng = IIf(RngEnd.Row < Rng.Row, Rng, LogWks.Range(Rng, RngEnd))
    
      For Each Cell In Rng
        DueDate = Cell.Offset(0, 12)
        If DateDiff("d", DueDate, Now()) > 30 Then
           MsgBox "CAR # " & Cell & " was due on " _
           & DueDate & " and is now overdue!"
           NextRow = NextRow + 1
           Dst.Offset(NextRow, 0) = Cell
           Dst.Offset(NextRow, 1) = DueDate
        End If
      Next Cell
      
End Sub