' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers ' by Jjuanhdez, 06/2022 Dim As Double t0 = Timer Dim As Integer N = 1, ArithCnt = 0, CompCnt = 0 Dim As Integer Div, DivCnt, Sum, Quot Print "The first 100 arithmetic numbers are:" Do Div = 1 : DivCnt = 0 : Sum = 0 Do Quot = N / Div If Quot < Div Then Exit Do If Quot = Div AndAlso (N Mod Div) = 0 Then 'N is a square Sum += Quot DivCnt += 1 Exit Do End If If (N Mod Div) = 0 Then Sum += Div + Quot DivCnt += 2 End If Div += 1 Loop If (Sum Mod DivCnt) = 0 Then 'N is arithmetic ArithCnt += 1 If ArithCnt <= 100 Then Print Using "####"; N; If (ArithCnt Mod 20) = 0 Then Print End If If DivCnt > 2 Then CompCnt += 1 Select Case ArithCnt Case 1e3 Print Using !"\nThe #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt Case 1e4, 1e5, 1e6 Print Using "The #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt End Select End If N += 1 Loop Until ArithCnt >= 1e6 Print !"\nTook"; Timer - t0; " seconds on i5 @3.20 GHz" Sleep