VBA: Index Match formular with multiple criterias (lookup an value based on multiple criteria)

[syzer]

Hello Guys,

I would like to receive back the specific "ID" value from check-sheet based on multiple criterias in VBA. I using Userform for data input, where I input all related informations and based on these values should I get the specific project "ID" from the data-base check-sheet.

The "ID" should be defined based on 3 criterias (part number, class type, revision number), but when I'm using Index.Match function then during program running I'm always facing with Type Mismatch error.

Does somebody have any idea, how I can solve and use the given formular or any other idea, how to lookup "ID" with 3 criterias? Thank you!

Private Sub OptionButton_Customer_Click()
If OptionButton_Internal.value = True Then
selected_type = OptionButton_Internal.Caption
ElseIf OptionButton_Customer.value = True Then
selected_type = OptionButton_Customer.Caption
ElseIf OptionButton_Supplier.value = True Then
selected_type = OptionButton_Supplier.Caption
End If

Set rev_data = Sheet7 'Set data-sheet
lr = rev_data.Range("A:A").SpecialCells(xlCellTypeLastCell).Row 'Found the last row in column

Set Rng1 = Sheet7.Range("E2:E" & lr) 'Define range for revision
Set Rng2 = Sheet7.Range("D2:D" & lr) 'Define range for part number
Set Rng3 = Sheet7.Range("F2:F" & lr) 'Define range for class type
Set Rng4 = Sheet7.Range("B2:B" & lr) 'Define range project id

sy = Application.WorksheetFunction.MaxIfs(Rng1, Rng2, L_Part_Number.value, Rng3, selected_type)

search_id = Application.WorksheetFunction.IfError(Application.WorksheetFunction.Index(rev_data.Range("B2:B7"), _
Application.WorksheetFunction.Match(1, (L_Part_Number.value = Rng2) * (OptionButton_Customer.Caption = Rng3) * (sy = Rng1), 0)), "The value is not existing")

MsgBox "ID Number:" & search_id

End Sub

 

[mumps]

It is hard to work with a picture. It would be easier to help if you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[Alex Blakenburg]

Unfortunately that format won't work in VBA and you will need to resort to using the evaluate method.
As mumps has pointed out without access to the file this is a bit hard to work with and I can't test the below but give it a try at your end.
Note:
• Ideally sy and search_id are given a specific data type but since I am guessing I went with variant.
• I have left in the Debug.Print line in case the formula I came up with doesn't work. In which case you can take the formula from the immediate window and try and get it working directly in Excel and then let us know what you had to change to make it work so we can modify the code.
• SpecialCells Last cell finds the last cell in the spreadsheet and will not restrict itself to the nominated column so I have replaced it.

Private Sub OptionButton_Customer_Click()
    Dim rev_data As Worksheet
    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range
    Dim sy As Variant                                    ' Change as required
    Dim search_id As Variant                             ' Change as required
    Dim lr As Long
    Dim sFormula As String
    
    If OptionButton_Internal.Value = True Then
        selected_type = OptionButton_Internal.Caption
    ElseIf OptionButton_Customer.Value = True Then
        selected_type = OptionButton_Customer.Caption
    ElseIf OptionButton_Supplier.Value = True Then
        selected_type = OptionButton_Supplier.Caption
    End If

    Set rev_data = Sheet2 'Set data-sheet
    
    With rev_data
        lr = .Range("A" & Rows.Count).End(xlUp).Row                'Found the last row in column
        
        Set Rng1 = .Range("E2:E" & lr) 'Define range for revision
        Set Rng2 = .Range("D2:D" & lr) 'Define range for part number
        Set Rng3 = .Range("F2:F" & lr) 'Define range for class type
        Set Rng4 = .Range("B2:B" & lr) 'Define range project id
    End With
    
    sy = Application.WorksheetFunction.MaxIfs(Rng1, Rng2, L_Part_Number.Value, Rng3, selected_type)

    sFormula = "=IfError(Index(" & Rng4.Address(external:=True) & "," & _
                    "Match(1, (" & Rng2.Address(external:=True) & "=" & L_Part_Number.Value & ") " & _
                    "* (" & Rng3.Address(external:=True) & "=" & OptionButton_Customer.Caption & ") " & _
                    "* (" & Rng1.Address(external:=True) & "=" & sy & ")" & _
                    ", 0)), ""The value is not existing"")"
                    
    Debug.Print sFormula                                    ' Remove once code is proved to be working
    search_id = Evaluate(sFormula)
    
    MsgBox "ID Number:" & search_id

End Sub

 

[syzer]

Hello Guys,

Unfortunately I can not share the whole document, due to some confidentinal informations, but I made soft version where you can see the Userform and the related Worksheet.

Download link:

Dropbox

www.dropbox.com

Short explanation about my goal regarding the occurred issue:

The userform serves to register new project on it, the projects are divided based on part numbers and class type.
In our situation there is 1 part number ("V121-00044A") and 3 different class type (Internal, Customer, Supplier).

If in the given class there is already registered some project from past, then the revision number should be automatically increased.
If there is not registered project for the given part number in given class, then revision number should be start from 0.

Example: In case of internal class for the product there are already registered more projects, therefore the "sy" defining the highest revision number based on criterias and increase the value with +1. (If the sy = 0 then increasing the value)

But in case of customer and supplier projects, there are not registered projects or just the revision 0 which is the basic. Therefore the "If sy = 0" solution is not proper for me, because the program never will be skip this number just overwriting the current data.

 

[syzer]

Unfortunately that format won't work in VBA and you will need to resort to using the evaluate method.
As mumps has pointed out without access to the file this is a bit hard to work with and I can't test the below but give it a try at your end.
Note:
• Ideally sy and search_id are given a specific data type but since I am guessing I went with variant.
• I have left in the Debug.Print line in case the formula I came up with doesn't work. In which case you can take the formula from the immediate window and try and get it working directly in Excel and then let us know what you had to change to make it work so we can modify the code.
• SpecialCells Last cell finds the last cell in the spreadsheet and will not restrict itself to the nominated column so I have replaced it.

Private Sub OptionButton_Customer_Click()
    Dim rev_data As Worksheet
    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range
    Dim sy As Variant                                    ' Change as required
    Dim search_id As Variant                             ' Change as required
    Dim lr As Long
    Dim sFormula As String
   
    If OptionButton_Internal.Value = True Then
        selected_type = OptionButton_Internal.Caption
    ElseIf OptionButton_Customer.Value = True Then
        selected_type = OptionButton_Customer.Caption
    ElseIf OptionButton_Supplier.Value = True Then
        selected_type = OptionButton_Supplier.Caption
    End If

    Set rev_data = Sheet2 'Set data-sheet
   
    With rev_data
        lr = .Range("A" & Rows.Count).End(xlUp).Row                'Found the last row in column
       
        Set Rng1 = .Range("E2:E" & lr) 'Define range for revision
        Set Rng2 = .Range("D2:D" & lr) 'Define range for part number
        Set Rng3 = .Range("F2:F" & lr) 'Define range for class type
        Set Rng4 = .Range("B2:B" & lr) 'Define range project id
    End With
   
    sy = Application.WorksheetFunction.MaxIfs(Rng1, Rng2, L_Part_Number.Value, Rng3, selected_type)

    sFormula = "=IfError(Index(" & Rng4.Address(external:=True) & "," & _
                    "Match(1, (" & Rng2.Address(external:=True) & "=" & L_Part_Number.Value & ") " & _
                    "* (" & Rng3.Address(external:=True) & "=" & OptionButton_Customer.Caption & ") " & _
                    "* (" & Rng1.Address(external:=True) & "=" & sy & ")" & _
                    ", 0)), ""The value is not existing"")"
                   
    Debug.Print sFormula                                    ' Remove once code is proved to be working
    search_id = Evaluate(sFormula)
   
    MsgBox "ID Number:" & search_id

End Sub

Unfortunately is not working, after running error 2015 occurs.

 

[Alex Blakenburg]

What line is highlighted when the error occurs ?
Assuming it's the evaluate line did you put the formula printed in the immediate window by the debug.print into excel and try and figure out what's wrong with it ?

 

[syzer]

 

[Alex Blakenburg]

Give this a try:

Private Sub OptionButton_Customer_Click()
    Dim rev_data As Worksheet
    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, Rng4 As Range
    Dim sy As Variant                                               'Change as required
    Dim search_id As String
    Dim lr As Long
    Dim sFormula As String
    
    If OptionButton_Internal.value = True Then
        selected_type = OptionButton_Internal.Caption
    ElseIf OptionButton_Customer.value = True Then
        selected_type = OptionButton_Customer.Caption
    ElseIf OptionButton_Supplier.value = True Then
        selected_type = OptionButton_Supplier.Caption
    End If

    Set rev_data = Sheet7                                           'Set data-sheet
    
    With rev_data
        lr = .Range("A" & Rows.Count).End(xlUp).Row                 'Found the last row in column
        
        Set Rng1 = .Range("E2:E" & lr) 'Define range for revision
        Set Rng2 = .Range("D2:D" & lr) 'Define range for part number
        Set Rng3 = .Range("F2:F" & lr) 'Define range for class type
        Set Rng4 = .Range("B2:B" & lr) 'Define range project id
    End With
    
    sy = Application.WorksheetFunction.MaxIfs(Rng1, Rng2, L_Part_Number.value, Rng3, selected_type)

    sFormula = "=IfError(Index(" & Rng4.Address(external:=True) & "," & _
                    "Match(1, (" & Rng2.Address(external:=True) & "=""" & L_Part_Number.value & """) " & _
                    "* (" & Rng3.Address(external:=True) & "=""" & OptionButton_Customer.Caption & """) " & _
                    "* (" & Rng1.Address(external:=True) & "=" & sy & ")" & _
                    ", 0)), ""The value is not existing"")"
                    
    sFormula = Replace(sFormula, "[" & ActiveWorkbook.Name & "]", "")
    search_id = Evaluate(sFormula)
    
    MsgBox "ID Number:" & search_id

End Sub

 

[syzer]

I appreciate your support, the formular working properly.

Thank you!

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.