VBA- Create frequency table using "count if smaller than"

[tkjohans]

I am trying to make a dynamic frequency table in VBA using the countif formula.

The general idea is to:
1) find the highest and lowest values in arange using "max" and "min" formula.
2) Create 30 intervals using interval (max-min)/30.
3) Use excelfunction count if to count the number observations within each interval.

I am quite new to VBA and programming in general. However has made the following attempt. The problem is, however, that the code only returns the value 0. Thank You

Sub distribution()
Dim low As Single
Dim high As Single
Dim rng As Range
Dim stp As Single

Set rng = Sheets("Aktivandel").Range("B3", Range("B3").End(xlDown))
low= WorksheetFunction.Min(rng)
high = WorksheetFunction.Max(rng)
stp = (high - low) / 30

For i = low To high Step stp
   For j = 1 To 30 
    a = WorksheetFunction.CountIf(rng, ">"&(i+stp)) - WorksheetFunction.CountIf(rng, "<"& i)
    i = i + stp
    Sheets("Summary").Range("A1").Offset(j, o) = a  
  Next j
Next i
 

End Sub

 

[VBA Geek]

If you have your values listed down column A, you can try the below. it will create a fre map in col C and D and the frequencies in column E


you can change the number in this to determine how many intervals u want

Const inte As Integer = 8

Sub FreqMap()
Dim iRange As Excel.Range
Dim iRow   As Integer
Dim imin   As Variant
Dim imax   As Variant
Const inte As Integer = 8
Dim iint   As Double
Dim mBins  As Variant
Dim mFreq  As Variant
iRow = Range("A" & Rows.Count).End(xlUp).Row
Set iRange = Range("A1:A" & iRow)
imin = CalcMin(iRange)
imax = CalcMax(iRange)
iint = CCur((imax - imin) / inte)
mBins = BuildBins(imin, iint, inte)
Range("C1").Resize(UBound(mBins), 2).Value = mBins
mBins = RemSigns(imin, iint, inte)
mFreq = WorksheetFunction.Frequency(iRange, mBins)
Range("E1").Resize(UBound(mFreq, 1)) = mFreq
End Sub
Private Function CalcMin(R As Range) As Variant
    CalcMin = WorksheetFunction.Min(R)
End Function
Private Function CalcMax(R As Range) As Variant
    CalcMax = WorksheetFunction.Max(R)
End Function
Private Function BuildBins(imin As Variant, iint As Variant, numofint As Integer) As Variant
Dim v As Variant
Dim R As Integer
ReDim v(1 To 1 + numofint, 1 To 2)
v(1, 1) = vbNullString
v(1, 2) = "<= " & imin
For R = 2 To UBound(v)
    v(R, 1) = "> " & Mid(v(R - 1, 2), 1 + InStr(1, v(R - 1, 2), Chr$(32)))
    v(R, 2) = "<= " & Mid(v(R, 1), 1 + InStr(1, v(R, 1), Chr$(32))) + iint
Next
BuildBins = v
End Function
Private Function RemSigns(imin As Variant, iint As Variant, numofint As Integer) As Variant
    Dim v As Variant
    Dim R As Integer
    ReDim v(1 To 1 + numofint, 1 To 1)
    v(1, 1) = imin
    For R = 2 To UBound(v) - 1
        v(R, 1) = v(R - 1, 1) + iint
    Next
    RemSigns = v
End Function