Max of unique values in cells separated by a delimiter

[sans]

Hello,

I'm looking to get as a result the max count of unique values, from cells separated by a dash. I am attaching an example where you can see what I mean. The data I will be analyzing are of similar nature to the data in the thread I started a while ago today here:

http://www.excelforum.com/excel-prog...separator.html


Again a udf function would be the most flexible solution though I do appreciate any help.


Thank you

[jindon]

=CountMax(C6:E6,"-")

Function CountMax(rng As Range, delim As String) As Long
    Dim r As Range, e
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng
            For Each e In Split(r.Value, delim)
                .Item(e) = .Item(e) + 1
            Next
            CountMax = Application.Max(CountMax, .Count)
            .RemoveAll
        Next
    End With
End Function

[mehmetcik]

Hi

I created a UDF to do just this a few years ago.

It used "," and "/" as delimiters. The first two rows tell the function what to do if the target cell is empty or has "-" in it.

I will dig it out for you.

Function HIGHEST(test As String)
If test = "-" Then HIGHEST = "-": GoTo 200
If test = "" Then HIGHEST = "TBA": GoTo 200

Dim no1 As Double

5   If Right(test, 1) = "," Or Right(test, 1) = "/" Then test = Left(test, Len(test) - 1): GoTo 5

10  If InStr(1, test, ",") = False And InStr(1, test, "/") = False Then pos = Len(test) + 1: GoTo 20

pos = InStr(1, test, ","): pos2 = InStr(1, test, "/"): If pos2 = 0 Then pos2 = pos
If pos = 0 Then pos = pos2

If pos2 < pos Then pos = pos2

20 temp = Left(test, pos - 1)
   If pos < Len(test) Then test = Trim(Right(test, Len(test) - pos))
   
   no1 = Val(Left(temp, pos - 1))
   
   If no1 > HIGHEST Then HIGHEST = no1

If test = temp Then GoTo 200

GoTo 10

200 ' Exit

End Function

[sans]

Hi jindon and mehmetcik,

Both macros work great! Exactly what I was looking for to achieve. Thank you very much for the replies! I was wondering if you could also help me with an additional variation with any of your macros.

Is it possible to receive as a result the max count of unique values between all the cells? I spent some time trying to edit your solutions but haven't succeeded.

Thank you both for the help!

[jindon]

Function CountUniq(rng As Range, delim As String) As Long
    Dim r As Range, e
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng
            For Each e In Split(r.Value, delim)
                .Item(e) = .Item(e) + 1
            Next
        Next
        CountUniq = .Count
    End With
End Function

[sans]

Hi jindon,

Exactly what I was looking for.

Thank you very much for all assistance in my threads!

[sans]

Hi jindon,

Sorry to be bothering you again, I was just wondering if you could have a look at the macros you've helped me with in post #2 and #5. They both take a long time to finish calculating, similar to the other thread I was having trouble with. Would it be possible to have a look if the calculation time can be minimized?

Thank you

[sans]

Hello jindon,

I am trying to edit your macro in your post #2, to receive the minimum instead of the maximum count. I edited

CountMax = Application.Max(CountMax, .Count)

to

CountMax = Application.Min(CountMax, .Count)

but I get only 0 as the result. Could you please have a look and let me know where I am going wrong?

Thank you very much

[jindon]

Function CountMax(rng As Range, delim As String) As Long
    Dim r As Range, e, flg as boolean
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For Each r In rng
            For Each e In Split(r.Value, delim)
                .Item(e) = .Item(e) + 1
            Next
            if not flg then
                countmax = .count : flg = true
            else
                CountMax = Application.Min(CountMax, .Count)
            end if
            .RemoveAll
        Next
    End With
End Function

[sans]

Thank you very much jindon, worked like a charm!