Nested if statement, loop or something else

Hello everyone,

I’m trying to find out the length of various projects using Excel or VBA. Looking at the image below, the project duration date can be found two different ways. The first way it can be found is the done date – create date. For project 1234, it would be cell B6 – B4. The second way it can be done is completion date/time – create. For project 2211, it would be cell D12 – B13. I want to find a way to do this instead of having to manually type in the formula each time. The only thought I currently have is using a nested if statement or a loop that finds the project duration if there’s a date and time in a cell. In this nested if or loop I am thinking about, it would search for the word create in A4 then look to see if there’s a data/time like in B4. If there is date/time in those cells, it should find the difference and put it in E3. After the word done in any project like in A6, it goes to the next project and searches for the word create again then the process starts over. If there isn’t a done date or a completion date/time like for project 4567, I’d like the loop to skip it if possible. When there isn’t a done date like project 2211 but a completion date/time, I’d like for the if statement or loop to find the difference and place it in E12. Does anyone have an idea of how this can be done?
Attachment 24351

Derrick
Post a copy of the Wb
rob

Here you go Rob

Assumptions:
- in column A, "Create" always appears after the project number,
- if there are two (or more) start dates in the project, the first one is selected,
- if column A is "Done", column B has date and in column D is the date of execution, then date from column D is taken,
- column F displays the duration in a more friendly form.

Code:

---

Sub ProjectsDuration()
    Dim rngData    As Range
    Dim rng        As Range
    Dim varAddrs    As Variant
    Dim lCount      As Long
    Dim i          As Long
    Dim rngDone    As Range
    Dim lDays      As Long
    Dim dtTime      As Date


    Set rngData = Range("A1").CurrentRegion


    'Range of data
    With rngData
        Set rngData = .Offset(2).Resize(.Rows.Count - 2, 4)
    End With


    'Number of projects
    lCount = Application.Evaluate("=SUMPRODUCT(ISNUMBER(" & rngData.Columns(1).Address & ")*1)")


    'Array of project addresses
    ReDim varAddrs(1 To lCount)
    lCount = 0


    Set rng = rngData.Columns(1).Cells(1).Offset(-1)


    'Determine the address of each project
    For i = 1 To rngData.Rows.Count
        If TypeName(rng.Offset(i).Value) = "Double" Then
            lCount = lCount + 1


            If lCount > 1 Then
                varAddrs(lCount - 1) = varAddrs(lCount - 1) & ":" & rng.Offset(i - 1).Address
                varAddrs(lCount) = rng.Offset(i).Address
            Else
                varAddrs(lCount) = rng.Offset(i).Address
            End If
        End If
    Next i


    'Address of the last project
    varAddrs(lCount) = varAddrs(lCount) & ":" & rng.Offset(i - 1).Address




    'Calculate and insert the result for each project
    For lCount = 1 To UBound(varAddrs)


        'If there is a date in column D (Completion Date/Time)
        If TypeName(Range(varAddrs(lCount)).Cells(1).Offset(, 3).Value) = "Date" Then
            'Insert the formula in column E
            With Range(varAddrs(lCount)).Cells(1).Offset(, 4)
                .FormulaR1C1 = "=RC[-1]-R[1]C[-3]"
                lDays = Int(.Value)
                dtTime = .Value - lDays
                'column F
                .Offset(, 1).Value = lDays & IIf(lDays <> 1, " days ", " day ") & Format(dtTime, "hh:mm")
            End With
        Else
            'No date in column D.
            'Find the cell with "Done" in the project under study
            Set rngDone = Range(varAddrs(lCount)).Find("Done")


            If Not rngDone Is Nothing Then
                'Insert the formula in column E only when "Done" was found
                With Range(varAddrs(lCount)).Cells(1).Offset(, 4)
                    .Formula = "=" & rngDone.Offset(, 1).Address(0, 0) & _
                              "-" & Range(varAddrs(lCount)).Cells(2).Offset(, 1).Address(0, 0)
                    lDays = Int(.Value)
                    dtTime = .Value - lDays
                    .Offset(, 1).Value = lDays & IIf(lDays <> 1, " days ", " day ") & Format(dtTime, "hh:mm")
                End With
            End If
        End If


    Next lCount


    MsgBox "Done", vbInformation, "Projects Duration"
End Sub

---

Artik

Not perfect because I'm out if time:
In cell E3 array-enter this formula:

Code:

---

=IF(ISNUMBER(A3),MAX(0,IF(MATCH("Done",A4:A$19,0)<MATCH(1,(ISNUMBER(A4:A$19)+ISBLANK(A4:A$19)),0),INDEX(B4:B$19,MATCH("Done",A4:A$19,0)),$D3)-B4),"-")

---

Array-entering means committing the formula to the sheet with Ctrl+Shift+Enter, not just Enter.
Copy down.
Notes:
If completion dates are present in both columns B and D for a given project, the column B one is used.
If no completion date is present at all for a given project 0 is displayed (not ideal, I know)
The formula depends on column A for:
1. Finding the Done row
2. Determining the extent of each project by using the presence of a number (or a blank cell) so this assumes all project numbers are just numbers. Because of this and to prevent an error for the bottom-most project duration, references to columns A and B need to include a blank cell below the table (not ideal), so in this case, although the table finishes at row 18, references in the formula include row 19. This also means that there should be no blank cells within the table in column A.
So lots of ifs and buts, however it seems to work here.