Assigning values from a table

[quetzal]

Hello,
this looks like a pretty easy thing but I'm still new to this VBA programing and cannot come to a solution:

I have a table(time of operations assigned to part numbers, see below) and my input which is the type of operation (in this particular case operation HE4 ColNum=12) and a range of chosen part numbers up to 35 members (in this particular case PartNumbers= Range("D4, D6, D8, D14, D22").Value)

I just want to assign the time to the part numbers por the operation, find the lowest time value(s) and find out to what part number(s) it belongs to.

The result for this case should be 3008023, 3008181 and 3007758 because they have the lowest operation time 370min for the chosen operation type HE4. Any help is appreciated. Thank you
Attachment 16317

[mdmackillop]

Problem with attachment. Please use Manage Attachments

[quetzal]

Problem with attachment. Please use Manage Attachments

File reauploaded

[mdmackillop]

Can you attach a sample workbook, rather than an image.

[quetzal]

Can you attach a sample workbook, rather than an image.

PRODUCT_TIME.xlsm

Here is the excel file. I don't even know how to start. The output should be an array of those part numbers from chosen input range that have the lowest operation time for the particular operation. I really appreaciate your help. Thank you

[mdmackillop]

How do you identify the relevant part numbers and particular operation.

[quetzal]

That is a difficult process to explain so let say the relevant part numbers are in the active range and the operation comes from the variable ColNum which is actualy a column number.

[mdmackillop]

If you want an output, you need an input. You need to provide a mechanism for identifying the part numbers and operation.

[quetzal]

If you want an output, you need an input. You need to provide a mechanism for identifying the part numbers and operation.

This procedure is a part of long and complicated code which is kinda complicated to explain so I wrote a code which substitutes the mechanism for the identification of the part numbers (PartNumbers As Array) and the operation (ColNum As Integer).
Hopefully, this is the last issue that I have with the code.

Thank you very much with your help
PRODUCT_TIME_NEW.xlsm

[mdmackillop]

Give this a try

[quetzal]

Give this a try

That is genius!
It really works correctly.
I like the way how you choose the column number:

oSet = Range("3:3").Find(aStep).Column - 4

. This is pretty useful.

But I dunno how to put the yellow marked part numbers in an array for further use in a program.

Thank you

[mdmackillop]

Sub Test()
    Dim Rng As Range, r As Range
    Dim i As Long, x As Long
    Dim arr
    Dim aStep As String
    Dim oSet As Long
    Dim Mn
    Dim cel As Range, Lcel As Range


    'Reset to original
    Range("B:C").ClearContents
    For Each cel In ActiveSheet.UsedRange
    If cel.Interior.ColorIndex = 6 Then cel.Interior.ColorIndex = xlNone
    If cel.Interior.ColorIndex = 35 Then cel.Interior.ColorIndex = xlNone
    Next cel
    Range("D3:D38").Interior.Color = Range("F3").Interior.Color


    'Choose column
    aStep = UCase(InputBox("Enter Step", , "NF8"))


    oSet = Range("3:3").Find(aStep).Column - 4
    
    'Find Product cells
    Set Rng = Range("D:D")
    arr = Data
    x = UBound(arr)
    Set r = Rng.Find(arr(0))
    For i = 0 To x
        Set r = Union(r, Rng.Find(arr(i)))
    Next
    'Mark cells for checking; not use in code
    r.Offset(, -1) = "x"
    'Set range to selected column
    Set r = r.Offset(, oSet)
    
    'Find minimum value; exclude 0
    Mn = 10000
    For Each cel In r
        If Mn > cel And cel <> 0 Then Mn = cel.Value
    Next
    'Test for min values and apply colour
    'Create result array
    ReDim arr(Range("D:D").Count)
    i = 0
    For Each cel In r
        If cel = Mn Then
            cel.Interior.ColorIndex = 6
'Add data to array and increment            
arr(i) = cel.Offset(, -oSet)
            i = i + 1
'End of array creation
            cel.Offset(, -oSet).Interior.ColorIndex = 6
        Else
            cel.Interior.ColorIndex = 35
            cel.Offset(, -oSet).Interior.ColorIndex = 35
        End If
    Next
    ReDim Preserve arr(i - 1)
        
    'Show result from array
    Range("B4").Resize(i) = Application.Transpose(arr)
    Range("B4").EntireColumn.AutoFit
    
End Sub

[quetzal]

Thank you very much!