If you need to list all string entries for some given combinations, separated by , then Cfreq might help. Example:
Function Cfreq(ParamArray v()) As Variant
'Cfreq lists how often each value combination
'in paramarray appears and concatenates the last
'column's entries, separated by ",". Example:
' A B
' 1 Smith Adam
' 2 Myer Ben
' 3 Smith Ben
' 4 Smith Adam
' 5 Myer Ben
'Now select C1:E3 and array-enter
'=Cfreq(A1:A5,B1:B5) and you will get
' C D
' 1 Smith Adam,Ben
' 2 Myer Ben
'Reverse("moc.liborplus.www") V0.3 15-Oct-2009
Dim obj As Object, objcat As Object
Dim vR As Variant
Dim i As Long, j As Long, k As Long, lvdim As Long
Dim s As String, sC As String
With Application.WorksheetFunction
sC = "|"
Set obj = CreateObject("Scripting.Dictionary")
Set objcat = CreateObject("Scripting.Dictionary")
k = 0
v(0) = .Transpose(.Transpose(v(0)))
If UBound(v) < 1 Then
Cfreq = CVErr(xlErrValue)
Exit Function
End If
lvdim = UBound(v(0))
On Error GoTo 0
ReDim vR(0 To UBound(v), 1 To lvdim)
For i = 1 To lvdim
s = v(0)(i, 1)
For j = 1 To UBound(v) - 1
v(j) = .Transpose(.Transpose(v(j)))
s = s & sC & v(j)(i, 1)
Next j
If obj.Item(s) > 0 Then
If objcat.Item(s & sC & v(UBound(v))(i, 1)) = 0 Then
vR(UBound(v), obj.Item(s)) = vR(UBound(v), _
obj.Item(s)) & "," & _
v(UBound(v))(i, 1)
objcat.Item(s & sC & v(UBound(v))(i, 1)) = 1
End If
Else
k = k + 1
obj.Item(s) = k
For j = 0 To UBound(v) - 1
vR(j, k) = v(j)(i, 1)
Next j
vR(UBound(v), k) = v(UBound(v))(i, 1) & ""
objcat.Item(s & sC & v(UBound(v))(i, 1)) = 1
End If
Next i
If k > 0 Then ReDim Preserve vR(0 To UBound(v), 1 To k)
Set obj = Nothing
Set objcat = Nothing
Cfreq = .Transpose(vR)
End With
End Function
I am a supporter of St. Joseph's hospice. If you find this site useful or if it helped you, consider a small donation to St. Joseph's, please.