Hello Christopher,

this is my proposal: first generate a list holding n, Divisors of n and the Length of the list of divisors. Then you do a postprocessing (here executed by f1 and f2) and mark the "highly composite" numbers with a label (here "Red").

tab1 = Table[{n, Divisors[n], Length[Divisors[n]]}, {n, 1, 50}];
f1[{x_, max_}] := If[x[[3]] > max, {x, x[[3]], Red}, {x, max, White}]
f2[x_] := {y, max, color} = f1[{x, max}]
max = 0;
tab3 = Map[f2[#] &, tab1];
TableForm[tab3, TableDepth -> 2, 
 TableHeadings -> {None, {"n", "Divisors", "Len", "Color"}}]`