Help! I need a macro to check dates and autopopulate cells

[Monomeeth]

Hello

I have a spreadsheet used for managing tasks. Column D is for DUE DATE and
Column F is for STATUS. Presently, Column F has conditional formatting and
validation set so that there are only three possible options for users to
enter: (1) Completed; (2) On Track; and, (3) Overdue.

What I would like is to have a macro which runs automatically on launch to
check the DUE DATE to see if it falls before today's date and, if so, to
change the status to Overdue. I would need the macro to check each row until
it hits a blank row. Of course, if the DUE DATE is today's date or after
today's date, then the Status for that row would be left untouched.

Any help would be most appreciated!

Thanks,

Joe.

 

[Mike]

Private Sub Workbook_Open()
Const DUE_DATE = "D"
Const STATUS = "F"
Dim r As Long

r = 2 'starting row
Do While Len(Range("A" & r).Formula) > 0
If Cells(r, DUE_DATE).Value < Date Then
Cells(r, STATUS).Value = "OverDue"
Else
Cells(r, STATUS).Value = ""
End If
r = r + 1 ' next row
Loop
End Sub

 

[JP]

How about this?

Sub DoSomething()

Dim cell As Excel.Range

For Each cell In Range("D2", Range("D65536"). _
End(xlUp).SpecialCells(xlCellTypeConstants, 1))

If cell.Value < Now Then
cell.Offset(0, 2).Value = "Overdue"
End If

Next cell

End Sub


HTH,
JP

 

[JP]

How about this?

Sub DoSomething()

Dim cell As Excel.Range

For Each cell In Range("D2", Range("D65536"). _
End(xlUp).SpecialCells(xlCellTypeConstants, 1))

If cell.Value < Now Then
cell.Offset(0, 2).Value = "Overdue"
End If

Next cell

End Sub


HTH,
JP

 

[Monomeeth]

Hi Mike / JP

Thanks for your help. One problem though:

Whilst your macros work, I've now realised that we also don't want the macro
to change the status to Overdue if the status happens to already be marked as
Complete.

I'm not sure how to adapt your macros to make this improvement? Your help
would be greatly appreciated!

 

[JP]

Change

If cell.Value < Now Then
cell.Offset(0, 2).Value = "Overdue"
End If

to this:

If cell.Value < Now Then
If cell.Offset(0, 2).Value <> "Completed" Then
cell.Offset(0, 2).Value = "Overdue"
End If
End If


HTH,
JP

 

[Monomeeth]

Thanks JP. That works perfectly!

 

[JP]

Glad to hear it!

--JP