"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:
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-2009
Dim obj As Object
Dim vR As Variant
Dim i As Long
Set obj = CreateObject("Scripting.Dictionary")
With Application.WorksheetFunction
vR = .Transpose(.Transpose(v))
On Error Resume Next
For i = LBound(vR, 1) To UBound(vR, 1)
obj.Item(vR(i, 1)) = obj.Item(vR(i, 1)) + 1
Next i
Lfreq = .Transpose(Array(obj.keys, obj.items))
End With
End 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-2010
Dim obj As Object
Dim i As Long
Set obj = CreateObject("Scripting.Dictionary")
For i = 1 To r.Count
obj.Item(r(i).Value) = obj.Item(r(i).Value) + 1
Next i
Lfreq2 = Application.WorksheetFunction.Transpose(Array(obj.keys, obj.items))
Set obj = Nothing
End Function
Please note that GSort has just been used here to beautify/sort the output.
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
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-2010
Dim obj As Object
Dim i As Long
Set obj = CreateObject("Scripting.Dictionary")
For i = 1 To r.Count
obj.Item(r(i).Value) = obj.Item(r(i).Value) + 1
Next i
With Application
If .Caller.Rows.Count > .Caller.Columns.Count Then
Lfreq3 = .Transpose(obj.items)
Else
Lfreq3 = obj.items
End If
End With
Set obj = Nothing
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.
