Rough Goldbach Splits Programming Challenge

I am working on a programming challenge in the Wolfram Mathematica language named Rough Goldbach Splits
I have the following line of code but it takes too long to run:

num1[b_, p_, x_] := b^p/2 + x
NestWhileList[# + 1 &, 2, 
 Select[Range[2, 2017], Mod[num1[10, 2017, #], #] == 0 &] != {} &]

Range generates the integers 2 through 2017.
Select picks which integers satisfy the criterion with Mod.
NestWhileList returns the result of looping while the condition is true as a list.
The example given has 87 as the answer.

Select[Range[2, 2017], Mod[num1[10, 2017, 86], #] == 0 &]
{2, 7, 13, 14, 26, 91, 169, 182, 338, 383, 766, 1183} (*Output*)
Select[Range[2, 2017], Mod[num1[10, 2017, 87], #] == 0 &]
{} (*Output*)

How can I accelerate the program to evaluate faster?