Sub CfreqSub(rOutput As Range, rInputClasses As Range, _
rInputProperties As Range, Optional sDel As String = ",")
'CfreqSub lists each value combination in rInputClasses and
'concatenates their properties given in rInputProperties,
'separated by ",". Output starts in [upper left cell of] rOutput.
'Now call CfreqSub(C1,A1:A5,B1:B5) and you will get
'PLEASE NOTE: This sub was created to overcome Cfreq's
'limitation of max 256 characters in input and output
'Reverse("moc.liborplus.www") V0.20 09-Oct-2011
Dim obj As Object, objcat As Object
Dim i As Long, j As Long, k As Long, lvdim As Long
Dim s As String, sC As String
Dim state As SystemState 'See http://sulprobil.com/html/systemstate.html
Set state = New SystemState 'See http://sulprobil.com/html/systemstate.html
With Application.WorksheetFunction
Set obj = CreateObject("Scripting.Dictionary")
Set objcat = CreateObject("Scripting.Dictionary")
lvdim = rInputClasses.Rows.Count
If lvdim <> rInputProperties.Count Then
Cfreq = CVErr(xlErrValue)
ReDim vR(1 To lvdim, 0 To rInputClasses.Columns.Count)
s = rInputClasses.Cells(i, 1)
For j = 2 To rInputClasses.Columns.Count
s = s & sC & rInputClasses.Cells(i, j)
If objcat.Item(s & sC & rInputProperties(i)) = 0 Then
vR(obj.Item(s), rInputClasses.Columns.Count) = vR(obj.Item(s), _
rInputClasses.Columns.Count) & sDel & rInputProperties(i)
objcat.Item(s & sC & rInputProperties(i)) = 1
For j = 1 To rInputClasses.Columns.Count
vR(k, j - 1) = rInputClasses.Cells(i, j)
vR(k, rInputClasses.Columns.Count) = rInputProperties(i) & ""
objcat.Item(s & sC & rInputProperties(i)) = 1
Range(rOutput.Cells(1, 1), rOutput.Cells(k, rInputClasses.Columns.Count + 1)) = vR