performance tuning – Finding the number of appearances that a number turns up in a certain list of numbers

I have the following code:

max = 4000; Clear[cnt]; 
cnt[_] = 0; Do[b = Binomial[n + 2, k + 1]; 
 If[b <= max, cnt[b] += 1], {n, 0, max}, {k, 1, n - 1}]; sel = 
 Select[Table[{b, cnt[b]}, {b, 1, max}], #[[2]] >= 1 &]; 
a[n_] := Select[sel, #[[2]] >= n &][[1, 1]]; 
Quiet@Array[a, 10^3] /. {}[[1, 1]] -> Nothing

The code is finding the number of appearances that a number turns up in a certain list of numbers. Is there a way to speed up this calculation, because it takes a while.