In its most basic way I need to know how long a product stays at a facility.

To give it a little bit of context it is for a main ground handler at an international airport where they want to know the answer to this question. Because I am doing an internship it is up to me to figure it out. However I could really use some help.

For an example on the data set i have it looks similar to this V V V

See below for what code I mixed and matched so far.

Sub MultipleSearch()

Sheet9.Activate

Dim ULD As String:
Dim ULD_Procedure As Variant
Dim i As Long
Dim rgSearch As Range
Dim ILastCol As Long
Dim cell As Range
Dim CollumnResult As Variant
Dim Result As Variant
Dim DateFlight As Variant


With Sheet9

    LastRow = WorksheetFunction.CountA(Range("B:B"))
            
    For i = 1 To LastRow
        
        ULD = Cells(i, 2).Value

        Sheet3.Activate
       
       ' Get search range
        
        Set rgSearch = Range("I:I")
        Set cell = rgSearch.Find(ULD)
    
        ' Store first cell address
        Dim firstCellAddress As Variant
        firstCellAddress = cell.Address

                ' Find all cells containing set ULD number
                Do
                Sheet9.Activate
                            
                    ILastCol = (1   Cells(i, Columns.Count).End(xlToLeft).Column)
                                              
                'Adjust CellAdres to only give me the correct Row number
                            
                    RowResult = cell.Address
                            
                    Result = Replace(RowResult, "$I$", "")
                            
                    Sheet3.Activate
                            
                    DateFlight = Cells(Result, 4).Value
                            
                    Sheet9.Activate
                            
                    Cells(i, ILastCol).Value = DateFlight
                            
                    Set cell = rgSearch.FindNext(cell)
                        
                Loop While firstCellAddress <> cell.Address
    
    Next i

        If cell Is Nothing Then
            Debug.Print "Not found"
        End If

End With

End Sub

This code miraculously works sort of. I get the dates the ULDs enter the system or left, and with the use of "basic" Excel formulas i can measure the time between ULDs. However not in the correct order, this is due to that not all ULDs enter the system in Inbound. Some are already here and the first record of those ULDs is outbound. Also some ULD miss registration on outbound or inbound. So saying they follow a standard order of inbound outbound inbound outbound is incorrect.

The solution I am looking at is pasting the date focused on inbound and outbound. How I want the result sheet to look like v v

How it currently looks v v v

I currently have no idea how to solve this problem. Furthermore, I'm certainly not asking you to write out my entire code and pass on the solution pre-made. But if you can make an outline of a possible formula / piece of code that I can use will help me tremendously!

If it's hopeless you can say it too.

[@Peh solution not working, but maybe im braindead]

It will show you for every Inbound how many days the flight stayed until its Outbound. If there is no Outbound it will mark it as no outbound.

So you can only calculate the stay time of the flight if it has an Inbound AND Outbound if one of them is missing you cannot calculate it.

To make statistics on that times you can use functions like AVERAGEIF for example to get the average stay time of a flight.

Edit according comment: You said:

1, 2, 3, 4 arrive on the 12th but on the 14th ULD; 1, 3, 5, 6 depart. The ULDs; 2, 4 may not leave the facility until a much later, for example the 30th. Now downtime on ULD; 1, 3 = 2 days, but ULD; 2, 4 has 18 down days.

So this would look like

After sorting (by number, date and direction) and using above formula I get:

CodePudding user response：

Sort the data on date/time and build a dictionary using the ULD numbers as keys and a collection of date/times as values. Loop through the collections writing date/times to either an even or odd column according to direction of travel. Data on sheets(1), report on sheets(2).

Sub MultipleSearch2()

    Dim wb As Workbook, ws As Worksheet, wsOut As Worksheet
    Dim rng As Range, r As Long, c As Long, n As Long
    Dim lastrow As Long, lastcol As Long
   
    Dim dict As Object, key, entry
    Set dict = CreateObject("Scripting.Dictionary")

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)  ' data
    Set wsOut = wb.Sheets(2)  ' output
    lastrow = ws.Cells(Rows.Count, "B").End(xlUp).Row
    lastcol = ws.Cells(1, Columns.Count).End(xlToLeft).Column

    Set rng = ws.Cells(1, 1).Resize(lastrow, lastcol)
    Debug.Print rng.Address
    
   ' sort sheet by date/time
    With ws.Sort
        .SortFields.Clear
        .SortFields.Add key:=ws.Range("D1"), SortOn:=xlSortOnValues, _
            Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange rng
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ' get list of uids (colI) build collection inbound/outbord
    Dim ID As String, dt As String, inout As String
    For r = 2 To lastrow
        ID = ws.Cells(r, "I")
        If Not dict.exists(ID) Then
            dict.Add ID, New Collection
        End If
        ' add to collection
        dt = Format(ws.Cells(r, "D"), "yyyy-mm-dd hh:mm:ss")
        inout = Left(ws.Cells(r, "P"), 1) ' I or O
        dict(ID).Add inout & "_" & dt, CStr(r)
    Next

    ' output results
    r = 2
    With wsOut
        .Cells.Clear
        .Range("A1:B1") = Array("ULD Number", "First Entry")
        .Rows(1).Font.Bold = True
        For Each key In dict.keys
            ID = CStr(key)
            .Cells(r, 1) = ID
            c = 3
            n = 0
            For Each entry In dict(ID)
                ' inbound odd, outbound even
                If Left(entry, 1) = "O" Then
                    If c Mod 2 = 1 Then c = c   1
                    ' extend header
                    If .Cells(1, c - 1) = "" Then
                        .Cells(1, c - 1) = "Inbound"
                        .Cells(1, c) = "Outbound"
                    End If
                Else
                    If c Mod 2 = 0 Then c = c   1
                        If .Cells(1, c) = "" Then
                            .Cells(1, c) = "Inbound"
                            .Cells(1, c   1) = "Outbound"
                        End If
                End If
                wsOut.Cells(r, c) = Split(entry, "_")(1) ' remove I_
                ' first entry
                n = n   1
                If n = 1 Then .Cells(r, 2) = .Cells(1, c)
                c = c   1
            Next
            r = r   1
        Next
    End With
    MsgBox "Done"
End Sub