I am a supporter ofSt. Joseph's hospice. If you find this site useful or if it helped you, consider a small donation toSt. Joseph's, please. Information onSt. Joseph's
 "Not everything that counts can be counted, and not everything that can be counted counts."[Albert Einstein] If you like to create a statistic about frequencies of strings or numbers, you can use pivot tables or perhaps one of my UDF's shown below. Lfreq uses associative arrays like PERL, List_Freq relies on a collection and offers a more complex functionality:
 Please note that GSort has just been used here to beautify/sort the output.
 Function Lfreq(v As Variant) As Variant'Lfreq lists how often each value in v appears.'Reverse("moc.liborplus.www") PB V0.5 07-Mar-2009Dim obj As ObjectDim vR As VariantDim i As LongSet obj = CreateObject("Scripting.Dictionary")With Application.WorksheetFunctionvR = .Transpose(.Transpose(v))On Error Resume NextFor i = LBound(vR, 1) To UBound(vR, 1)    obj.Item(vR(i, 1)) = obj.Item(vR(i, 1)) + 1Next iLfreq = .Transpose(Array(obj.keys, obj.items))End WithEnd Function Lfreq2 which works on ranges only is a bit faster: Function Lfreq2(r As Range) As Variant'Lfreq2 lists how often each value in r appears.'Reverse("moc.liborplus.www") PB V0.1 25-Apr-2010Dim obj As ObjectDim i As LongSet obj = CreateObject("Scripting.Dictionary")For i = 1 To r.Count    obj.Item(r(i).Value) = obj.Item(r(i).Value) + 1Next iLfreq2 = Application.WorksheetFunction.Transpose(Array(obj.keys, obj.items))Set obj = NothingEnd Function
 Function Lfreq3(r As Range) As Variant'Lfreq3 returns a frequency statistic of the input.'Example: Lfreq3({"a","a","b","b","b"}) will return {2,3}'Reverse("moc.liborplus.www") PB V0.10 03-Sep-2010Dim obj As ObjectDim i As LongSet obj = CreateObject("Scripting.Dictionary")For i = 1 To r.Count    obj.Item(r(i).Value) = obj.Item(r(i).Value) + 1Next iWith ApplicationIf .Caller.Rows.Count > .Caller.Columns.Count Then    Lfreq3 = .Transpose(obj.items)Else    Lfreq3 = obj.itemsEnd IfEnd WithSet obj = NothingEnd Function
 A variant which only lists dupes: Sub Ld()'Ld lists dupes of column A in column B.'Reverse("moc.liborplus.www") PB V0.1 10-Mar-2013Dim obj As ObjectDim i As Long, vRange("B:B").ClearContentsSet obj = CreateObject("Scripting.Dictionary")For Each v In Intersect(Range("A:A"), ActiveSheet.UsedRange)    If Not IsEmpty(v) Then obj.Item(v.Value) = obj.Item(v.Value) + 1Next vFor i = obj.Count - 1 To 0 Step -1    If obj.Items()(i) < 2 Then obj.Remove obj.Keys()(i)Next iIf obj.Count > 0 Then Range("B1:B" & obj.Count).FormulaArray = _    Application.WorksheetFunction.Transpose(obj.Keys)End Sub
 Function List_Freq(rngSource As Range, _     Optional lngLength As Long = 5) As Variant 'List_Freq counts strings of lngLength subsequent 'cells and returns a list of sorted strings and 'their frequencies. 'Example: 'If A1:C2 are filled with the numbers '0 1 0 '1 0 1 'then =List_Freq(A1:C2,2) array-entered in '4 cells (2x2 array of cells, enter with CTRL + 'SHIFT + ENTER) will return '01 2 '10 2 'the first column consisting of strings Dim coll As New Collection Dim lngFreq As Long, lngIndex As Long Dim lngFound As Long Dim i As Long, j As Long, k As Long Dim sPattern As String If rngSource.Columns.Count < lngLength Then     List_Freq = CVErr(xlErrValue)     Exit Function End If ReDim vA(1 To rngSource.Rows.Count * _     (rngSource.Columns.Count - lngLength + 1), _     1 To 2) As Variant On Error Resume Next 'Count the frequencies For j = 1 To rngSource.Rows.Count     For i = 1 To rngSource.Columns.Count - _             lngLength + 1         sPattern = rngSource.Cells(j, i)         For k = 1 To lngLength - 1             sPattern = sPattern & _                 rngSource.Cells(j, i + k)         Next k         Err.Clear         lngFound = coll("X" & sPattern)         If Err.Number <> 0 Then             lngIndex = lngIndex + 1             coll.Add lngIndex, "X" & sPattern             vA(lngIndex, 1) = sPattern             vA(lngIndex, 2) = 1         Else             vA(lngFound, 1) = sPattern             vA(lngFound, 2) = vA(lngFound, 2) + 1         End If     Next i Next j 'Sort output For i = 1 To lngIndex     For j = i + 1 To lngIndex         If vA(i, 1) > vA(j, 1) Then             sPattern = vA(j, 1)             vA(j, 1) = vA(i, 1)             vA(i, 1) = sPattern             lngFound = vA(j, 2)             vA(j, 2) = vA(i, 2)             vA(i, 2) = lngFound         End If     Next j Next i List_Freq = vA End Function