ClearAll[FactorionQ] FactorionQ[n_,b_:10]:=Total[IntegerDigits[n,b]!]==n Select[Range[1500000],FactorionQ[#,9]&] Select[Range[1500000],FactorionQ[#,10]&] Select[Range[1500000],FactorionQ[#,11]&] Select[Range[1500000],FactorionQ[#,12]&]