Modifying a lookup UDF for delimited values to make it also remove duplicates

Viewed 27

I have two functions (below). Both work perfectly on their own. I also have a data set, similar to this: enter image description here

In column C, the function =RemoveDupes2(LookupSP(B2,$A$9:$B$11,1,2,",",",","ERROR"),",") works to spit out the results, as desired. The problem is my actual dataset is much larger, so some rows end up exceeding the 32,676 cell character limit, which results in a #VALUE!. To circumvent this, I want to see if it's possible to combine the two below UDFs, so the same function performs the lookup and the dupe removal.

I validated that this would work in theory for my examples by manually CONCATing certain classes together, performing the dupe removal, then CONCATing the remaining.

UDF that looks at multiple values in a delimited cell, looks up all of them, and concatenates the outputs:

Function LookupSP( _
    ByVal ClassString As String, _
    ByVal LookupRange As Range, _
    Optional ByVal ClassColumn As Long = 1, _
    Optional ByVal SecurityPointColumn As Long = 2, _
    Optional ByVal ClassDelimiter As String = ",", _
    Optional ByVal SecurityPointDelimiter As String = ",", _
    Optional ByVal NotFoundString As String = "Not found") _
As String
    
    If Len(ClassString) = 0 Then Exit Function
    
    Dim Classes() As String: Classes = Split(ClassString, ClassDelimiter)
    
    Dim ccrg As Range
    Dim scrg As Range
    
    With LookupRange
        Set ccrg = .Columns(ClassColumn)
        Set scrg = .Columns(SecurityPointColumn)
    End With
    
    Dim rIndex As Variant
    Dim n As Long
    Dim spString As String
    
    For n = 0 To UBound(Classes)
        rIndex = Application.Match(Classes(n), ccrg, 0)
        If IsNumeric(rIndex) Then
            spString = CStr(scrg.Cells(rIndex).Value)
        Else
            spString = NotFoundString
        End If
        LookupSP = LookupSP & spString & SecurityPointDelimiter
    Next n
    
    LookupSP = Left(LookupSP, Len(LookupSP) - Len(SecurityPointDelimiter))
    
End Function

UDF that performs a within-cell duplicate removal:

Function RemoveDupes2(txt As String, Optional delim As String = " ") As String
Dim X
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For Each X In Split(txt, delim)
        If Trim(X) <> "" And Not .exists(Trim(X)) Then .Add Trim(X), Nothing
    Next
    If .Count > 0 Then RemoveDupes2 = Join(.keys, delim)
End With
End Function
0 Answers
Related