' FB 1.05.0 Win64

Function multDigitalRoot(n As UInteger, ByRef mp As Integer, base_ As Integer = 10) As Integer
  Dim mdr As Integer
  mp = 0
  Do
    mdr = IIf(n > 0, 1, 0)
    While n > 0
      mdr *= n Mod base_
      n = n \ base_
    Wend
    mp += 1
    n = mdr
  Loop until mdr < base_
  Return mdr
End Function

Dim As Integer mdr, mp
Dim a(3) As UInteger = {123321, 7739, 893, 899998}
For i As UInteger = 0 To 3
 mp = 0
 mdr = multDigitalRoot(a(i), mp)
 Print a(i); Tab(10); "MDR ="; mdr; Tab(20); "MP ="; mp
 Print
Next
Print
Print "MDR    1     2     3     4     5"
Print "===  ==========================="
Print
Dim num(0 To 9, 0 To 5) As UInteger '' all zero by default
Dim As UInteger n = 0, count = 0
Do
  mdr = multDigitalRoot(n, mp)
  If num(mdr, 0) < 5 Then
    num(mdr, 0) += 1
    num(mdr, num(mdr, 0)) = n
    count += 1
  End If
  n += 1
Loop Until count = 50

For i As UInteger = 0 To 9
  Print i; ":" ;
  For j As UInteger = 1 To 5
    Print Using "######"; num(i, j);
  Next j
  Print
Next i

Print
Print "Press any key to quit"
Sleep