Count number of X+ occurrences of value in range - excel

Question

I am working on a project and was wondering if there might be a faster way of doing something that seems easy, but is fairly time consuming.
Pretend I have a 10 cell column filled with random integers from 1-10:
1
1
1
5
5
8
8
8
9
9
I want to get a count of x+ occurrence of this column. Func(1)=4 [since there are 4 unique values with at least 1 occurrence]; Func(2) =4; func(3)=2 [since only 2 unique values occur at least 3 times]
Right now I filter through each possible integer, then count occurrences. If occurrences >=x then count +=1. Then cycle through through each integer. It work, but on larger ranges of cells with greater range of integers, it is a bit slow. Given Excel's flexibility and the power of VBA, I'm wondering if anyone has an idea that is more efficient.

Answer 1

One approach might be using a function like the below (but you'll need to add a reference by doing: Open VB Editor > Click Tools > References > Scroll down to "Microsoft Scripting Runtime" > Tick it > Click OK)
Option Explicit
Public Function CountNumericOccurrences(ByVal someRange As Range, ByVal minimumOccurrenceCount As Long) As Long
' "someRange" can be a contiguous or non-contiguous range of cells
' "minimumOccurrenceCount" is how many occurrences must be present before that value is counted.
' This function will only count numbers (strings, blanks, etc are ignored).
Dim uniqueCounts As Scripting.Dictionary
Set uniqueCounts = New Scripting.Dictionary
Dim contiguousArea As Range
For Each contiguousArea In someRange.Areas
If contiguousArea.Cells.Count > 1 Then ' Unlikely that range would contain any single-cell areas
Dim inputToCheck As Variant
inputToCheck = contiguousArea.Value
Dim rowIndex As Long
Dim columnIndex As Long
Dim currentKey As String
For rowIndex = LBound(inputToCheck, 1) To UBound(inputToCheck, 1)
For columnIndex = LBound(inputToCheck, 2) To UBound(inputToCheck, 2)
If Application.IsNumber(inputToCheck(rowIndex, columnIndex)) Then ' IsNumeric returns True for vbEmpty, so isNumber is used instead.
currentKey = CStr(inputToCheck(rowIndex, columnIndex))
If Not uniqueCounts.Exists(currentKey) Then uniqueCounts.Add currentKey, 0 ' Default value
uniqueCounts(currentKey) = uniqueCounts(currentKey) + 1
End If
Next columnIndex
Next rowIndex
ElseIf Application.IsNumber(contiguousArea) Then ' Handle single-cell edge case
currentKey = CStr(contiguousArea) ' We repeat ourselves here. Could create a "default dictionary" class, but only 3 lines repeated.
If Not uniqueCounts.Exists(currentKey) Then uniqueCounts.Add currentKey, 0 ' Default value
uniqueCounts(currentKey) = uniqueCounts(currentKey) + 1
End If
Next contiguousArea
For rowIndex = 0 To (uniqueCounts.Count - 1)
If uniqueCounts.Items(rowIndex) >= minimumOccurrenceCount Then
CountNumericOccurrences = CountNumericOccurrences + 1
End If
Next rowIndex
End Function
If you put it into a new module, you can call it from the worksheet as such:
I tested it with a range consisting of 200k cells, and it took ~4 seconds (quite slow). Maybe using a collection would be a better approach.
You could also just call it as part of a regular procedure e.g.:
Option Explicit
Private Sub SomeProcedure()
Dim someValue As Long
someValue = CountNumericOccurrences(ThisWorkbook.Worksheets("Sheet1").Range("A1:A200000"), 3)
MsgBox someValue
End Sub