HMatchIf_Multi

Returns column if an item from list of items was found in a row.
Similar to HMatch, but this one searches for multiple items at the same time and can return 1 of three types.

CodeFunctionName
What is this?

Public

Tested

Original Work
Function HMatchIf_Multi(List_of_Values, InRow, Optional Wb = "This", Optional Shee = "Active", Optional StartFromCol = "A", Optional ReturnVal = 1, Optional Sepa = "|")
    ' Similar to HMatchIf, but searches for one of the items in List_of_Values, and returns value found, or column index where found
    ' ReturnVal = 0 ' Returns columnName
    ' ReturnVal = 1 ' Returns column index
    ' ReturnVal = 2 ' Returns the header that was found
    ' List_of_Values = one or more values separated by Sepa
    '
    ' Needs GetColumnName
    '
    Rett = ""
    If Wb = "This" Then Wb = ThisWorkbook.Name
    If Wb = "Active" Then Wb = ActiveWorkbook.Name
    If Shee = "Active" Then Shee = ActiveSheet.Name
    If ReturnVal = 0 Then Rett = ""
    If ReturnVal = 1 Then Rett = 0
    If ReturnVal = 2 Then Rett = ""
    Row1End = GetColumnName(Workbooks(Wb).Worksheets(Shee).Range("A1").Offset(, Workbooks(Wb).Worksheets(Shee).Range("A1").EntireRow.Columns.Count - 1).Address) & InRow
   
    For Each RoVal In Split(List_of_Values, Sepa)
        CoCo1 = WorksheetFunction.CountIf(Workbooks(Wb).Worksheets(Shee).Range(StartFromCol & InRow, Row1End), RoVal)
        If CoCo1 > 0 Then
            If CoCo1 = 0 Then Goto NextRoVal
            On Error Resume Next
            Err.Clear
            LastOne = WorksheetFunction.Match(RoVal , Workbooks(Wb).Worksheets(Shee).Range(StartFromCol & InRow, Row1End), 0) + Range(StartFromCol & 1).Column - 1
            If Err.Number = 0 Then GoTo GotIt
            Err.Clear
            LastOne = WorksheetFunction.Match(Val(RoVal ), Workbooks(Wb).Worksheets(Shee).Range(StartFromCol & InRow, Row1End), 0) + Range(StartFromCol & 1).Column - 1
            If Err.Number = 0 Then GoTo GotIt
            Err.Clear
            LastOne = WorksheetFunction.Match(CStr(RoVal ), Workbooks(Wb).Worksheets(Shee).Range(StartFromCol & InRow, Row1End), 0) + Range(StartFromCol & 1).Column - 1
            If Err.Number = 0 Then GoTo GotIt
            Err.Clear
            On Error GoTo 0
            Goto NextRoVal
GotIt:
            Err.Clear
            On Error GoTo 0
            If ReturnVal = 0 Then Rett = CutString(Range(Cells(1, LastOne).Address).Address(True, False), "", "$", 1)
            If ReturnVal = 1 Then Rett = LastOne
            If ReturnVal = 2 Then Rett = RoVal
            Exit For
        End If
NextRoVal:
    Next
    HMatchIf_Multi = Rett
End Function

List_of_Values, InRow, Optional Wb = "This", Optional Shee = "Active", Optional StartFromCol = "A", Optional ReturnVal = 1, Optional Sepa = "|"

Views 179

Downloads 45

CodeID
DB ID