Chess Algorithm Optimization

[Nucleus]

I was asked by a friend if it was possible to have a horse start in any spot on a standard chess board and jump on every square.

I have constructed an algorthim to do the crunching for me. However, it takes more than 2 hours ( I gave up waiting after 2 hours) to go through all the permutations.

Anyone have any suggestions on how to optimise the algorithm so that it takes less time?

For a start I have string concatenation in there which is slow.

If it is not possible with VB, perhaps with c++ or are there simply too many permutations?

Here is the algorithm:

Private Sub Command1_Click()
Dim timeit As Date
timeit = Time
Call KnightMoves(4, 1, ",41,")
Debug.Print FormatDateTime(Time - timeit, vbLongTime)
MsgBox "Finished"
End Sub
 
Function KnightMoves(ByVal x, ByVal y, ByVal PrevMoves$)
 Dim newx&, newy&, b1 As Boolean, b2 As Boolean, b3 As Boolean, b4 As Boolean
 Dim b5 As Boolean, b6 As Boolean, b7 As Boolean
 
 newx = x + 2
 newy = y + 1
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    b1 = True
 End If
 
 newy = newy - 2
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    b2 = True
 End If
    
 newx = newx - 4
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    b3 = True
 End If
 
 newy = newy + 2
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    b4 = True
 End If
 
 newx = newx + 1
 newy = newy + 1
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    b5 = True
 End If
 
 newx = newx + 2
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    b6 = True
 End If
 
 newy = newy - 4
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    b7 = True
 End If
 
 newx = newx - 2
 If CBool(newx > 0 And newx < 9 And newy > 0 And newy < 9) And InStr(1, PrevMoves, "," & newx & newy & ",", vbBinaryCompare) = 0 Then
    Call KnightMoves(newx, newy, PrevMoves & newx & newy & ",")
 Else
    If b1 And b2 And b3 And b5 And b6 And b7 Then
        If Len(PrevMoves) = 193 Then Debug.Print PrevMoves
    End If
    
 End If
 
End Function