Consulting

Results 1 to 2 of 2

Thread: Calculate Age of Project

  1. #1

    Calculate Age of Project

    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!
    Attached Files Attached Files

  2. #2

    Red face Found Code that will help!

    In the Thread Post from Trebor 76 for Find dupe row, move one of them:

    [VBA]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[/VBA]

    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •