This is similar to Neighbors, except that four such numbers in a row are sought rather than just three. So the program is a modifification of the program for that puzzle. It's been enhanced to show the actual factors.

DefDbl A-Z

Dim fct(20, 1)

Function mform$(x, t$)

  a$ = Format$(x, t$)

  If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$

  mform$ = a$

End Function

Private Sub Form_Load()

 Text1.Text = ""

   For n = 2 To 10000

     a = b: b = c: c = d

     f = factor(n)

     nf = 1

     For i = 1 To f

      nf = nf * (fct(i, 1) + 1)

     Next

     d = nf

     If a = b And b = c And c = d Then

       Text1.Text = Text1.Text & Str(n - 3) & Str(c) & Chr(13) & Chr(10)

       For dnd = n - 3 To n

         For dvr = 1 To dnd / 2

           If dnd Mod dvr = 0 Then Text1.Text = Text1.Text & Str(dvr)

         Next

         Text1.Text = Text1.Text & Str(dnd) & Chr(13) & Chr(10)

       Next

       Text1.Text = Text1.Text & Chr(13) & Chr(10)

     End If

   Next

  

End Sub

Function factor(num)

 diffCt = 0: good = 1

 n = Abs(num): If n > 0 Then limit = Sqr(n) Else limit = 0

 If limit <> Int(limit) Then limit = Int(limit + 1)

 dv = 2: GoSub DivideIt

 dv = 3: GoSub DivideIt

 dv = 5: GoSub DivideIt

 dv = 7

 Do Until dv > limit

   GoSub DivideIt: dv = dv + 4 '11

   GoSub DivideIt: dv = dv + 2 '13

   GoSub DivideIt: dv = dv + 4 '17

   GoSub DivideIt: dv = dv + 2 '19

   GoSub DivideIt: dv = dv + 4 '23

   GoSub DivideIt: dv = dv + 6 '29

   GoSub DivideIt: dv = dv + 2 '31

   GoSub DivideIt: dv = dv + 6 '37

   If INKEY$ = Chr$(27) Then s$ = Chr$(27): Exit Function

 Loop

 If n > 1 Then diffCt = diffCt + 1: fct(diffCt, 0) = n: fct(diffCt, 1) = 1

 factor = diffCt

 Exit Function

DivideIt:

 cnt = 0

 Do

  q = Int(n / dv)

  If q * dv = n And n > 0 Then

    n = q: cnt = cnt + 1: If n > 0 Then limit = Sqr(n) Else limit = 0

    If limit <> Int(limit) Then limit = Int(limit + 1)

   Else

    Exit Do

  End If

 Loop

 If cnt > 0 Then

   diffCt = diffCt + 1

   fct(diffCt, 0) = dv

   fct(diffCt, 1) = cnt

 End If

 Return

End Function

shows the first several, with n under 10,000.

In each case the first line shows n, together with the number of factors. The next four lines show the actual sets of factors for each of the four successive numbers.

 242 6

 1 2 11 22 121 242

 1 3 9 27 81 243

 1 2 4 61 122 244

 1 5 7 35 49 245

 3655 8

 1 5 17 43 85 215 731 3655

 1 2 4 8 457 914 1828 3656

 1 3 23 53 69 159 1219 3657

 1 2 31 59 62 118 1829 3658

 4503 8

 1 3 19 57 79 237 1501 4503

 1 2 4 8 563 1126 2252 4504

 1 5 17 53 85 265 901 4505

 1 2 3 6 751 1502 2253 4506

 5943 8

 1 3 7 21 283 849 1981 5943

 1 2 4 8 743 1486 2972 5944

 1 5 29 41 145 205 1189 5945

 1 2 3 6 991 1982 2973 5946

 6853 8

 1 7 11 77 89 623 979 6853

 1 2 23 46 149 298 3427 6854

 1 3 5 15 457 1371 2285 6855

 1 2 4 8 857 1714 3428 6856

 7256 8

 1 2 4 8 907 1814 3628 7256

 1 3 41 59 123 177 2419 7257

 1 2 19 38 191 382 3629 7258

 1 7 17 61 119 427 1037 7259

 8392 8

 1 2 4 8 1049 2098 4196 8392

 1 7 11 77 109 763 1199 8393

 1 2 3 6 1399 2798 4197 8394

 1 5 23 73 115 365 1679 8395

 9367 8

 1 17 19 29 323 493 551 9367

 1 2 4 8 1171 2342 4684 9368

 1 3 9 27 347 1041 3123 9369

 1 2 5 10 937 1874 4685 9370