Return Most Frequent Bin Of Numbers

Option Explicit


Function Freq(NumberRange As Range, Span As Double) As Double
    Dim SmallestNumber As Double
    Dim PotentialBuckets()
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim LowerRange As Double
    Dim Number As Range
    Dim Numbers() As Double
    Dim BucketCount As Integer
    Dim LargestBucket As Integer
    Dim Temp As Double


    SmallestNumber = Application.WorksheetFunction.Min(NumberRange)


    ReDim Numbers(NumberRange.Count)
    ReDim PotentialBuckets(NumberRange.Count, 3)


    'assign range to array
    For i = 1 To NumberRange.Count
        Numbers(i) = NumberRange.Cells(1, i)
    Next i


    'BubbleSort Numbers
    For i = 1 To NumberRange.Count
        k = i
        For j = i + 1 To NumberRange.Count
            If Numbers(k) > Numbers(j) Then
                k = j
            End If
        Next j
        If i <> k Then
            Temp = Numbers(i)
            Numbers(i) = Numbers(k)
            Numbers(k) = Temp
        End If
    Next i


    'bucket numbers by frequency
    For i = 1 To NumberRange.Count
        LowerRange = Numbers(i)
        PotentialBuckets(i, 1) = LowerRange
        BucketCount = 0
        For j = i To NumberRange.Count
            If Numbers(j) >= LowerRange And Numbers(j) <= LowerRange + Span Then
                PotentialBuckets(i, 2) = Numbers(j)
                BucketCount = BucketCount + 1
                PotentialBuckets(i, 3) = BucketCount
            Else: Exit For
            End If
        Next j
    Next i


    'determine largest fequncy (Ties go to lower numbers)
    LargestBucket = 1
    For i = 1 To NumberRange.Count - 1
        If PotentialBuckets(i + 1, 3) > PotentialBuckets(LargestBucket, 3) Then
            LargestBucket = i
        End If
    Next i
    i = LargestBucket


    'assign range to Freq
    Freq = PotentialBuckets(i, 1) & "." & PotentialBuckets(i, 2)
End Function