View Single Post
  #2 (permalink)  
Old May 16th, 2007, 02:47 PM
allenm allenm is offline
Friend of Wrox
Points: 513, Level: 8
Points: 513, Level: 8 Points: 513, Level: 8 Points: 513, Level: 8
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Feb 2007
Location: Davenport, IA, USA.
Posts: 163
Thanks: 0
Thanked 2 Times in 2 Posts
Default

Not sure if you want to call the procedure or have it assigned to a button. I've created a button called Update_Button for the example. The due date would need to be an actual date field or the code won't work without some tweaking.

Assuming your detail starts in row 2, A1 is Action_Due_Date, A2 is Action Status, and Action_Status_Update is A3:
---------------------------------------------------------------------
Private Sub Update_Button_Click

'Changes Due Dates
  Dim dStart As Date, dEnd as Date, iRowOn As Long
  dStart = cDate(Month(Now) & "/" & Day(Now) & "/" & Year(Now))
  dEnd = dStart + 90 'Dates count by number of days, so this sets dEnd 90 extra days out
  iRowOn = 2
  With ActiveSheet
    Do While .Cells(iRowOn, 1).Value & " " <> " " 'Processes until hits first blank cell in Column A
      If UCase(.Cells(iRowOn, 2).Value) = "CLOSED" Then
        .Cells(iRowOn, 3).Value = "Done"
      ElseIf .Cells(iRowOn, 1).Value >= dStart And .Cells(iRowOn, 1).Value <= dEnd Then
        .Cells(iRowOn, 3).Value = "Due Soon"
      ElseIf .Cells(iRowOn, 1).Value > dEnd Then
        .Cells(iRowOn, 3).Value = "Over Due"
      Else
        .Cells(iRowOn, 3).Value = "Not Due Yet"
      End If
      iRowOn = iRowOn + 1
    Loop
  End With

End Sub
---------------------------------------------------------------------

Reply With Quote