VBA UDF to find multi column criteria match using

2019-09-14 20:57发布

I posted a question in regards to finding a match with multi-column criteria. The provided answer works great. But I'm trying to make it a universal solution for my project, in terms of how many columns criteria is used.

Here is the question I am referencing: Question & Answer I used

Here is what I've managed to come up with so far:

Public Function CRITERIA(ParamArray values() As Variant) As Variant
  ....
  CRITERIA = values

End Function

Where the actual UDF referenced in the cells will be:

Public Function MULTIMATCHEXISTS(args As Variant, ParamArray colmns() As Variant) As Boolean

Dim argsCount As Long, colmnsCount As Long, cl As Long, a As Long
argsCount = UBound(args) - LBound(args) + 1
colmnsCount = UBound(colmns) - LBound(colmns) + 1

Dim tbl As ListObject 
Dim ws As Worksheet 
Dim lr As ListRow
Dim match_candidate As Variant, arg As Variant

If argsCount <> colmnsCount Then
    ....
    Exit Function
Else

    'Get the name of the table from any column provided (this of courses assumes a 1:1 table search) 
    Set tbl = colmns(0).ListObject
    'Get tables worksheet from the table object
    Set ws = ThisWorkbook.Sheets(tbl.Parent.Name)

    'Iterate through columns?
    For cl = LBound(colmns) To UBound(colmns) 

        'Get each value from column
        For each lr In tbl.ListRows

           match_candidate = Intersect(lr.Range, colmns(cl)).value

           'Iterate through arguments?
           For a = LBound(args) To UBound(args)

               If match_candidate = args(a) Then
                  Debug.Print "its a match for " & args(a) & " in column " & colmns(cl)

                   MULTIMATCHEXISTS = True

                Else 

                   MULTIMATCHEXISTS = False

               End If

            Next a

        Next lr

    Next cl

End If

End Function

Where someone would use the UDF as follows:

 =MULTIMATCHEXISTS(CRITERIA(A2,A3,A4), Table2[Column1], Table2[Column8], Table2[Column5])

Basically what I would like is for it to validate if the first value = it's respective queried column and so forth (I.e args(0) should = colmns(0) value, args(1) should = colmns(1) value)

So far, I can find matches using the above example, but I don't know how to check if ALL values match at the same time. Additionally I can't find any native functions to compare arrays on the MSDN site. It's an awkward site to navigate IMO.

Don't let my rep fool you. I'm new to VBA and will be the first to admit my newbiness, I'm having a hard time converting over. I don't find the MSDN documentation to be as helpful as other languages, personally. So if you can share any resources you use I would appreciate it.


enter image description here


In an effort to simplify my desired outcome:

Take table 1 that has a list of clients:

         A                B               C           D
  -----------------------------------------------------------
1 |    Name    |        Email        |  Phone  |  ISMATCH?  |
  -----------------------------------------------------------
2 | Steve Jobs | stevejobs@gmail.com |  123456 |    True    |
  -----------------------------------------------------------
3 | Bill Gates | billgates@apple.com |  123456 |    True    |
  -----------------------------------------------------------
4 |  Steve Woz | stevewoz@outlook.com|  123456 |    False   |
  -----------------------------------------------------------

Take table 2 that has a detailed description of those clients, but every client is queried by different arguments:

          J            K         L                M
  -----------------------------------------------------------
1 |     Name     |  Company |  Phone  |        Email          |
  -----------------------------------------------------------
2 | Steve Jobs   |   Apple  |  123456 | stevejobs@gmail.com   |
  -----------------------------------------------------------
3 | Bill Gates   |   Apple  |  123456 | billgates@apple.com   |
  -----------------------------------------------------------
4 |Stevie Wonder |   Apple  |  123456 | steviewon@outlook.com  |
  -----------------------------------------------------------

What I would like is to be able to pick and choose which criteria to evaluate and then select their corresponding columns in Table 2. So back in Table 1 D2 it would be something like this:

  =MULTIMATCHEXISTS(CRITERIA([@NAME], [@EMAIL]), Table2[Name], Table2[Email])

But lets say for bill gates I want to check more than those 2 criteria, so Table 1 D3 would be:

  =MULTIMATCHEXISTS(CRITERIA([@NAME], [@PHONE], [@EMAIL]), Table2[Name], Table2[Phone], Table2[Email])

And for Steve Woz Table 1 D4:

  =MULTIMATCHEXISTS([@Name], Table2[Name])

Those are practical examples of my UDF in action. Im trying to make both arguments dynamically flexible. I live off of named ranges, but it doesn't have to be specific to that

3条回答
放我归山
2楼-- · 2019-09-14 21:22

Try this. Note there is no error checking.
The Filter_Data array is 1-based but the ParamArray is zero-based!

OPTION COMPARE TEXT
Function MULTIMATCHEXISTS(Filter_Data As Variant, ParamArray Values() As Variant) As Variant
    Dim j As Long
    Dim k As Long

    MULTIMATCHEXISTS = False
    If TypeOf Filter_Data Is Range Then Filter_Data = Filter_Data.Value2

    For j = LBound(Filter_Data) To UBound(Filter_Data)
        For k = LBound(Values) To UBound(Values)
            If Filter_Data(j, k + 1) = Values(k) Then
                '
                ' true if all the columns match
                '
                If k = UBound(Values) Then MULTIMATCHEXISTS = True
            Else
                Exit For    ' do not check remaining columns
            End If
        Next k
        '
        ' exit at first row match for all cols
        '
        If MULTIMATCHEXISTS Then Exit For
    Next j

End Function
查看更多
别忘想泡老子
3楼-- · 2019-09-14 21:23

I found a solution that works for me and my needs; I played around with Charles' answer and couldn't quite figure out the structure based on his feedback. Although, I did take some of the information I learned from his feedback and applied it. Hopefully this can help someone else, as ugly or coarse it is. I think I was making it too hard on myself trying to visualize the loops within the loops within the loops. So I decided to settle for an Index/Match approach.

And more importantly, I really want to learn this language, so if you're a pro out there and spot something wrong I should focus on please let me know.

Public Function MULTIMATCHEXISTS(args As Variant, ParamArray colmns() As Variant) As Boolean
  Dim argsCount As Long, colmnsCount As Long
  Dim i As Long, lRow As Long
  Dim match_candidate As Variant
  Dim cell As Range

  On Error GoTo Handler
    argsCount = UBound(args) - LBound(args) + 1
    colmnsCount = UBound(colmns) - LBound(colmns) + 1

check:

  MULTIMATCHEXISTS = False

  'Check if array counts match before even commencing a query, if not throw #value error
  If argsCount = colmnsCount Then

On Error GoTo DoesNotExist:
    'Check if minimum requirements are met
    If argsCount = 1 Then
        'If only 1 argument given find the first match
        lRow = Application.WorksheetFunction.match(args, colmns(0), 0)

        MULTIMATCHEXISTS = True
        Exit Function
    ElseIf argsCount > 1 Then
        'Get all values from the first column provided in the colmns() array
        'rest of the columns don't matter so we don't need to iterate through them because this is 1:1 Table search function
         For Each cell In colmns(0)

            If UCase(args(1)) = UCase(cell.value) Then
            'Found a match
            'Set the lRow to each cells row number
            'I don't like getting the row number of a ListObject cell by substracting from HeaderRowRange,
            'some people don't use table headers resulting in false returns
            lRow = cell.Row - cell.ListObject.ListRows(1).Range.Row + 1

            For i = 0 To UBound(args)
            'Get all values in each column in colmns() within the same row
              match_candidate = Application.WorksheetFunction.index(colmns(i), lRow, 0)

              'Check if all values match their respective arguments
              If args(i + 1) = match_candidate Then
                If i + 1 = argsCount Then
                'All values match args; exit function
                    MULTIMATCHEXISTS = True
                    Exit Function
                End If
              Else
                'Not all values match, go to next cell iteration to check for more cells that match args(1)
                GoTo NextCell
              End If
            Next i
            End If        
NextCell:
        Next cell
    End If
  Else
    GoTo Handler
  End If

Handler:
  ''Handle Err
  If Err.Number = 13 Then
    Err.Clear
    If Not IsEmpty(args) And Not IsEmpty(colmns(0)) Then
        argsCount = 1
        colmnsCount = 1
        Resume check
    End If
  Else 
   'Dirty
    MsgBox 1/0
  End If

DoesNotExist:
    MULTIMATCHEXISTS = False
    Exit Function

  End Function

So basically I do a dynamic INDEX/MATCH validation and process it accordingly. I can now call =MULTIMATCHEXISTS with as little as 1 argument/column to undefined:

=MULTIMATCHEXISTS(CRITERIA(A2,A3,A4,A5,A6,A7), Table2[Column2], Table2[Column3], Table2[Column4], Table2[Column5], Table2[Column6], Table2[Column7])

Where 1 argument is:

=MULTIMATCHEXISTS(A2, Table2[Column5])

Although the name 'multimatch' doesn't quite fit in that circumstance

I'm still interested to see what others come up with if you want to chime in with your 2 cents

查看更多
smile是对你的礼貌
4楼-- · 2019-09-14 21:46

OK, here is a version that more closely matches what you want: it is the equivalent of MATCH for your arbitrary set of criterias and columns.
Call example: =multimatch2(criteria(C2,B2,A2),C4:C70,B4:B70,A4:A70)

    Option Compare Text
Function MULTIMATCH2(Criterias As Variant, ParamArray Cols() As Variant) As Variant
    '
    ' return row index for multi-column match
    '
        Dim j As Long
        Dim k As Long
        Dim vColArr() As Variant
        '
        MULTIMATCH2 = 0
        '
        ReDim vColArr(LBound(Cols) To UBound(Cols))
        '
        For k = LBound(Cols) To UBound(Cols)
            If TypeOf Cols(k) Is Range Then
                '
                ' convert column ranges to array of 2-d array values
                '
                vColArr(k) = Cols(k).Value2
            End If
            '
            ' convert criteria to values
            '
            If TypeOf Criterias(k + 1) Is Range Then Criterias(k + 1) = Criterias(k + 1).Value2
        Next k
        '
        For j = LBound(vColArr(0)) To UBound(vColArr(0))
            For k = LBound(Cols) To UBound(Cols)
                '
                ' each element of vColarr contains a 2d array of values
                '
                If vColArr(k)(j, 1) = Criterias(k + 1) Then
                    '
                    ' set Row Index if all the columns match
                    '
                    If k = UBound(Cols) Then MULTIMATCH2 = j
                Else
                    Exit For    ' do not check remaining columns
                End If
            Next k
            '
            ' exit at first row match for all cols
            '
            If MULTIMATCH2 > 0 Then Exit For
        Next j
        '
    End Function
    Public Function CRITERIA(ParamArray values() As Variant) As Variant
    '....
        CRITERIA = values
    End Function
查看更多
登录 后发表回答