Home > Mobile >  Excel: search and delete columns depending on min/max values
Excel: search and delete columns depending on min/max values

Time:11-10

I have a very large table with input and output times of articles. I would like to put the cycle time in a graphic.

enter image description here

In the red box are the serial numbers of my articles. The yellow box are the start times and in the green box the end times. There are NOT always 3 same serial numbers, but can also be completely different (e.g. 6 same serial numbers).

To display the cycle time I need the earliest start time from the yellow box (min) and the maximum from the green box as end time (max) from ONE serial number.

This is not possible manually, because the sheet is too large. Does anyone have an idea with the implementation? The problem is not to find the min out of the yellow box and the max out of the green box, but rather the formula to search through the column after same serial numbers.

CodePudding user response:

Please, test the next solution/code. Since you did not answer the clarification questions, it assumes that the shown columns are "A:D" and time in columns "B:D" is formatted as Date ("hh:mm:ss"). The code uses a dictionary to keep unique serial numbers and calculate/store te minimum of second column and maximum of the fourth one. The serial numbers may appear in any order:

Sub ExtractMinMaxDates()
   Dim sh As Worksheet, lastR As Long, i As Long, arr, arrEl, arrFin
   Dim key As Variant, dict As Object
   
   Set sh = ActiveSheet 'use here the necessary sheet
   lastR = sh.Range("A" & sh.rows.count).End(xlUp).row 'last row
   
   arr = sh.Range("A2:D" & lastR).Value2 'place the range in an array for faster iteration/processing
   
   Set dict = CreateObject("Scripting.Dictionary") 'set the necessary dictionary
   For i = 1 To UBound(arr)    'iterate between the array rows
        If Not dict.Exists(arr(i, 1)) Then 'if a dictionary key has not been created:
            dict.Add arr(i, 1), Array(arr(i, 2), arr(i, 4)) 'make it and place (as item) an array containing
        Else                                                'time from columns 2 and 4
            arrEl = dict(arr(i, 1))                         'place the item in an array
            If arr(i, 2) < arrEl(0) Then arrEl(0) = arr(i, 2) 'keep the minimum
            If arr(i, 4) > arrEl(1) Then arrEl(1) = arr(i, 4) 'keep the maximum
        End If
   Next i
   'Redim the final array to keep the dictionary data:
   ReDim arrFin(1 To dict.count, 1 To 3): i = 1

   'fill the final aray with the necesssary data
   For Each key In dict.Keys
        arrFin(i, 1) = key: arrFin(i, 2) = dict(key)(0)
        arrFin(i, 3) = dict(key)(1): i = i   1
   Next
   
   'Drop the array content at once anf format the necessary columns:
   With sh.Range("F2").Resize(dict.count, 3) 'it may return anywhere (just change "F2" with needed cell)
        .Value2 = arrFin
        .Columns(2).EntireColumn.NumberFormat = "hh:mm:ss"
        .Columns(3).EntireColumn.NumberFormat = "hh:mm:ss"
  End With
End Sub

Please, send some feedback after testing it.

  • Related