Function with variable number of conditions

Function Function ReturnCategory(Item1 As String, SubGroup as String, Line_Code as String, Group1 as String) As String 
     '    Dim tbl As ListObject
     '    Set tbl = Sheets("lookup_ref").ListObjects(1)
     
    If ITEM1 = "CD36917" And SUBGROUP Like "09*" And LINE_CODE Like "*N8WV1*" And GROUP1 = "555" Then 
        ReturnCategory = "ABC" 
    ElseIf ITEM1 = "KM39352" And LINE_CODE Like "*XY00000ZS36W4*" And GROUP1 = "555" Then 
        ReturnCategory = "DEF" 
    ElseIf LINE_CODE Like "*N8WV1*" And GROUP1 = "555" Then 
        ReturnCategory = "JKL" 
         
         '.....
    End If 
     
End Function

Sub Pulsar(): Dim IT As String, SG As String, LC As String, GP As String
Dim wr As Worksheet, wd As Worksheet, r As Long, d As Long, CAT As String
        Set wr = Sheets("lookup_ref"): Set wd = Sheets("data")
For r = 4 To wr.Range("F" & Rows.count).End(xlUp).Row
                IT = wr.Cells(r, 3):  GP = wr.Cells(r, 6)
    If wr.Cells(r, 5) <> "" Then LC = "*" & wr.Cells(r, 5) & "*" Else LC = ""
    If wr.Cells(r, 4) <> "" Then SG = "*" & wr.Cells(r, 4) & "*" Else SG = ""


        For d = 3 To wd.Range("B" & Rows.count).End(xlUp).Row: CAT = wd.Cells(d, 8)
        If wd.Cells(d, 4) = IT And wd.Cells(d, 3) Like SG And _
        wd.Cells(d, 5) Like LC And wd.Cells(d, 2) = GP Then
                    GoSub RetCat: GoTo GetNext
        ElseIf wd.Cells(d, 4) = IT And _
        wd.Cells(d, 5) Like LC And wd.Cells(d, 2) = GP Then
                    GoSub RetCat: GoTo GetNext
        [B][COLOR=#ff0000]ElseIf wd.Cells(d, 5) Like LC And wd.Cells(d, 2) = GP Then
                    GoSub RetCat: GoTo GetNext[/COLOR][/B]
        End If: Next d
GetNext:        Next r: Exit Sub
RetCat: wr.Cells(r, 2) = CAT: CAT = "": Return
End Sub

Function myIncriment(X As Double, Optional Y As Double = 1, Optional Z As Double = 0) As Double
    Rem note that Y has a default value of 1


    myIncriment = X + Y + Z
End Function


Sub Test()
    MsgBox myIncriment(12): Rem returns 13


    MsgBox myIncriment(14, 2): Rem returns 16
    
    MsgBox myIncriment(21, , 4): Rem returns 26
End Sub

Function mySum(ParamArray Arguments() As Variant) As Double
    Rem Arguments will be a 0 based array
    
    Dim i As Long
    
    For i = 0 To UBound(Arguments)
        mySum = mySum + Arguments(i)
    Next i
End Function


Sub Demo()
    MsgBox mySum(1, 2, 3): Rem returns 6
    
    MsgBox mySum(1, 3, 5, 7, 9, 15): Rem returns 40
End Sub

Function myOtherSum(ArrayArgument As Variant)
    Dim oneArg As Variant
    
    For Each oneArg In ArrayArgument
        myOtherSum = myOtherSum + Val(oneArg)
    Next oneArg
End Function


Sub Demo2()
    MsgBox myOtherSum(Array(1, 2, 3)): Rem returns 6
    
    Dim myArray(1 To 4) As Double
    myArray(1) = 10
    myArray(2) = 12
    myArray(3) = 14
    myArray(4) = 18
    
    MsgBox myOtherSum(myArray): Rem returns 54
    
    MsgBox myOtherSum(Range("B1:B4")): Rem returns sum of values in B1:B4
End SubÏ
End Sub

Function myThirdSum(ParamArray Arguments() As Variant) As Double
    Rem Arguments will be a 0 based array
    Dim anArg As Variant
    Dim i As Long
    
    For i = 0 To UBound(Arguments)
        If TypeName(Arguments(i)) Like "*()" Or TypeName(Arguments(i)) = "Range" Then
            For Each anArg In Arguments(i)
                myThirdSum = myThirdSum + Val(anArg)
            Next anArg
        Else
            myThirdSum = myThirdSum + Val(Arguments(i))
        End If
    Next i
End Function


Sub ThirdDemo()
    MsgBox myThirdSum(2, 3, Array(10, 20, 30), 8, Range("A1:B4"))
End Sub

Sub Category_in_Data(rArray() As Variant)
    
    'Initiated just for EQUALS (excl. Contains, starting with), to test if it works (it doesn't)
    'x - rows,     y - columns dimensions
    
    Dim x As Long, y As Integer, hdrValue As String, strValue As String   'strings for alternative test
    Dim dataTbl As ListObject                'table on data sheet
    Dim dCol As Integer, dRow As Long        'data table header column, data row
    Dim dRNG As Range, bMatch As Boolean
    Dim dCAT As Range
    
    Set dataTbl = Sheet1.ListObjects(1)
    Set dRNG = dataTbl.DataBodyRange
    
    For dRow = 1 To dRNG.Rows.Count
        For x = 3 To UBound(rArray, 1)    'LookUP_ref; start at row 4
            For y = 2 To UBound(rArray, 2)   'LookUP_ref; start at column C
                If rArray(x, y) <> "" Then
                    '***************************************************************************************
                    ' Here's the problem. It overwrites ABC to JKL because it fulfills the criteria later on
                    '    and it's not possible to stack ANDs after each loop within a row
                    '***************************************************************************************
                   
                    dCol = dataTbl.HeaderRowRange.Find(CStr(rArray(1, y))).Column    'data table column position
                    
                    If dRNG(dRow, dCol).Value = rArray(x, y) Then
                        bMatch = True
                    End If
                    
                    If bMatch = False Then
                        Exit For
                    Else
                    Set dCAT = dRNG(dRow, dCol).Offset(, 50).End(xlToLeft)
                     If dCAT.Value = "" Then dCAT.Value = rArray(x, 1)
                    End If
                    
                    bMatch = False
                    '***********************************************
                    
                'Alternative TEST - to stack ANDs after each loop within row on ref sheet
                'type mismatch - probably expects a boolean, not string


'                strValue = strValue And CStr(rArray(x, y))
'                hdrValue = hdrValue And CStr(rArray(1, y))
                'Debug.Print strValue, hdrValue
                
                End If
            Next y
    
        Next x
    Next dRow
End Sub