CODEWITHSUNDEEP
excelvbauser-defined-functions
MCTP17
MCTP17

Reputation: 17

Have a UDF to perform a countif and "score" a row

I am trying to accomplish this task with a user-defined function. Currently I can accomplish the "scoring" with a helper row and cells. The dataset I am trying to implement this with is much larger than the image I have below and there is not an intermediary helper row between the rows I am trying to score.

The set up... Each row has 6 column values. These values can be also located in one of 6 defined tables. If the value occurs in one of the defined tables then based on which table it occurs in, there is a score to be assigned to it. If the value is not in a defined table then return a 1. I have named the tables, so one can reference them easily. The scoring is as follows:

I am currently accomplishing this with helper cells, the cell A3 has the following function: =IF(COUNTIF(Scent,A2)>0,7,IF(COUNTIF(Pigment,A2)>0,6,IF(COUNTIF(AO,A2)>0,5,IF(COUNTIF(MT,A2)>0,4,IF(COUNTIF(PPA,A2)>0,3,IF(COUNTIF(Antistat,A2)>0,2,1))))))

Once the individual "scoring" is done. I then want to return the largest and second largest value in a specific way. highest number.second highest number Cell G3 has this result as "7.5" because the row has a scent match and an AO match. It has the following function: =VALUE(LARGE(A3:F3,1)&"."&LARGE(A3:F3,2))

I have never made a user-defined function, I am unsure how to accomplish this. The output I currently have is in the range "A1:G5" The output I am trying to achieve is in the range "A9:G11"

The real dataset I am trying to use this for can have up to 18 column values in a row, but for simplicity sake, I am trying to get this to work for just 6 column values. I have only shown 3 rows, but the real dataset can have up to 120 rows. In addition to there being 6 predefined tables, that number could go up or down. That isn't something I am really concerned with because I don't think that number will change.

So i guess my question is, how do I get a UDF to perform this countif scoring method for a range that I give it? The range will be the individual rows I am trying to score. Below is a snip of my worksheet. Thank you all for any help or guidance! My current worksheet

github folder

Upvotes: 0

Views: 184

Answers (1)

FaneDuru
FaneDuru

Reputation: 42246

Try the next function, please. It uses named ranges, but the code can easily be adapted to use tables (like I understood that your case is):

Function fScoresN(rng As Range) As String
  Dim arrT As Variant, arrFin() As Long, i As Long, arrInt As Variant, c As Range
  Dim boolFound As Boolean
  
  arrT = Split("Scent|7,Pigment|6,AO|5,MC|4,PPA|3,Antistat|2", ",")
  
  ReDim arrFin(1 To UBound(arrT) + 1)
  
  For i = 0 To UBound(arrT)
    arrInt = Split(arrT(i), "|")
    Debug.Print arrInt(0)
    For Each c In rng.Cells
        If WorksheetFunction.CountIf(Names(arrInt(0)).RefersToRange, c.Value) > 0 Then
            arrFin(i + 1) = arrInt(1): boolFound = True: Exit For
        End If
    Next
    If Not boolFound Then arrFin(i + 1) = 1
    boolFound = False
  Next i
  fScoresN = WorksheetFunction.Large(arrFin, 1) & "." & WorksheetFunction.Large(arrFin, 2)
End Function

You must write the formula =fscoresN(A3:F3) and press enter

Please, use the next functions in case of Tables name used:

Function fScoresT(rng As Range) As String
  Dim arrT As Variant, arrFin() As Long, i As Long, arrInt As Variant, c As Range
  Dim boolFound As Boolean
  
  arrT = Split("Scent|7,Pigment|6,AO|5,MC|4,PPA|3,Antistat|2", ",")
  If Not TablesExist(arrT) Then Exit Function 'check the tables name consistency
  ReDim arrFin(1 To UBound(arrT) + 1) 'redim the array to finally be evaluated
  
  For i = 0 To UBound(arrT)
    arrInt = Split(arrT(i), "|") 'split the array on "|" to obtain the name and its score
    Debug.Print arrInt(0) 'only to visually see what's happening. It must be commented after testings
    For Each c In rng.Cells
        If WorksheetFunction.CountIf(ActiveSheet.ListObjects(arrInt(0)).DataBodyRange, c.Value) > 0 Then
            arrFin(i + 1) = arrInt(1): boolFound = True: Exit For
        End If
    Next
    If Not boolFound Then arrFin(i + 1) = 1 'in case of no match 
    boolFound = False
  Next i
  fScoresT = WorksheetFunction.Large(arrFin, 1) & "." & WorksheetFunction.Large(arrFin, 2) 'concatenation between the two Large score returns
End Function

and the function to check tables name:

Function TablesExist(arr As Variant) As Boolean
    Dim El As Variant, arrInt As Variant, T As ListObject, boolFound As Boolean
    For Each El In arr
        arrInt = Split(El, "|")
        For Each T In ActiveSheet.ListObjects
            If T.Name = arrInt(0) Then boolFound = True: Exit For
        Next
        If Not boolFound Then
            MsgBox "Table """ & arrInt(0) & """ does not exist, or it is wrongly spelled in arrT"
            TablesExist = False: Exit Function
        End If
        boolFound = False
    Next
    TablesExist = True
End Function

You must write the formula =fscoresT(A3:F3) and press enter

Upvotes: 1

Related Questions