PDA

View Full Version : Calculate Age of Project



mpadams77
02-28-2012, 08:30 PM
I am pulling data from a database that has related work orders. Each work order has a start date and an end date. I need to determine the age of each project programmatically. The way to calculate the length of time it takes to complete a project is to Subtract the Start Date of the First Work Order from the End Date of the last Work Order. Not every Work Order has another Linked Work Order so for those it simply is the difference of the Start and End dates for that record.
I've attached a copy of the Workbook that I am working in. Sheet 1 is a Pivot Table of Sheet 2. Please help on this challenging problem.

MW_MW_ID links all of the Related Workorders.
WO_NUMBER is the Unique Identifier for each work order and is generated chronologically, so the smallest WO# is the oldest.
WO_INIDATE is the Start Date.
WO_STATDATE is the End Date.
Any help is greatly appreciated!:help

mpadams77
02-29-2012, 08:29 PM
In the Thread Post from Trebor 76 for Find dupe row, move one of them:

Sub Macro2()

Dim lngLastRow As Long
Dim rngCell As Range, _
rngMyData As Range, _
rngMyDups As Range
Dim blnDupsExist As Boolean
Dim strPasteSheetName As String
lngLastRow = Sheets("Sheet1").Cells(Rows.Count, "H").End(xlUp).Row
Set rngMyData = Sheets("Sheet1").Range("H2:H" & lngLastRow)
blnDupsExist = False

Application.ScreenUpdating = False

For Each rngCell In rngMyData
If Application.WorksheetFunction.CountIf(rngMyData, rngCell.Value) > 1 Then
blnDupsExist = True
If rngMyDups Is Nothing Then
Set rngMyDups = rngCell.EntireRow
Else
Set rngMyDups = Union(rngMyDups, rngCell.EntireRow)
End If
End If
Next rngCell

If blnDupsExist = False Then
MsgBox "There are no duplicates in the range " & rngMyData.Address & ".", vbExclamation, "My Duplicates Editor"
Else
Worksheets.Add after:=Worksheets(Worksheets.Count)
With rngMyDups
.Copy Sheets(ActiveSheet.Name).Range("A2")
.EntireRow.Delete xlShiftUp
End With
MsgBox "The duplicates have now been moved to the """ & ActiveSheet.Name & """ tab.", vbInformation, "My Duplicates Editor"
End If

Application.ScreenUpdating = True

End Sub

This will seperate the Rows of data that have duplicate MW_MW_ID's from those that do not. What I would like to do is before it copies all of the duplicates and pastes them into a new table, I would like to evaluate which WO_NUMBER is the Smallest and which is the Largest and just bring over those two records into the new table. Can anyone give me a boost on this one? I am trying to solve a fairly complex problem with little VBA experience. :help