Reverse Travelling Salesman Module

Question

I'm learning VBA slowly and am working on a version of the travelling salesman problem to help myself out. In this particular case, the salesman moves from city to city by selecting the longest route possible between two points. The routes are calculated using cartesian coordinates and Euclidean distances. For this particular example, I have the table of coordinates below:

City X  Y
1   2   4
2   5   3
3   6   1
4   2   3
5   1   2
6   3   6
7   3   8
8   2   6
9   7   6
10  3   3

My code for this is below, and I hope it's commented enough to make sense:

Option Explicit

Sub newTSP()
    Dim nCities As Integer
    Dim distance() As Single
    Dim wasVisited() As Boolean
    Dim route() As Integer
    Dim totalDistance As Single
    Dim step As Integer
    Dim nowAt As Integer
    Dim nextAt As Integer
    Dim minDistance As Single 'TODO remove this
    Dim maxDistance As Single 'just to use in the distance loop
    Dim i As Integer, j As Integer
    Dim x1 As Integer, x2 As Integer, y1 As Integer, y2 As Integer
    Dim temp_dist As Single
    Dim coords As Range 'this is the table of coordinates

'my Euclidean distance array
    'count number of cities in the cartesian coordinates matrix
    nCities = Range(TSP.Range("a3").Offset(1, 0), TSP.Range("a3").Offset(1, 0).End(xlDown)).Rows.Count
    'now that we know the number of cities, redimension distance array
    ReDim distance(1 To nCities, 1 To nCities)
    'take the coordinates as a range
    Set coords = Range(TSP.Range("a3"), TSP.Range("a3").End(xlDown)).Resize(, 3)
    'put in the first arm of the matrix
    TSP.Range("e3") = "City"
    TSP.Range("e3").Font.Bold = True
    TSP.Range("e1") = "Distance Matrix"
    TSP.Range("e1").Font.Bold = True
    With TSP.Range("e3")
    For i = 1 To nCities
        .Offset(i, 0) = i
        .Offset(i, 0).Font.Bold = True
    Next
    'second arm of the matrix
    For j = 1 To nCities
        .Offset(0, j) = j
        .Offset(0, j).Font.Bold = True
    Next
    'fill it in with distances
    For i = 1 To nCities
        For j = 1 To nCities
            'the default value is 0
            If i = j Then
                TSP.Range("e3").Offset(i, j) = 0
            'otherwise look for euclidean distance
            Else
            'search for the coordinates for each value
                x1 = WorksheetFunction.VLookup(i, coords, 2, False) 'x of i
                y1 = WorksheetFunction.VLookup(i, coords, 3, False) 'y of i
                x2 = WorksheetFunction.VLookup(j, coords, 2, False) 'x of j
                y2 = WorksheetFunction.VLookup(j, coords, 3, False) 'y of j
                temp_dist = Sqr(((x1 - x2) ^ 2) + ((y1 - y2) ^ 2))
                TSP.Range("e3").Offset(i, j) = temp_dist
            End If
        Next
    Next
    End With

    'Array where route will be stored. Starts and ends in City 1
    ReDim route(1 To nCities + 1)
    route(1) = 1
    route(nCities + 1) = 1

    'Boolean array indicating whether each city was already visited or not. Initialize all cities (except City 1) to False
    ReDim wasVisited(1 To nCities)
    wasVisited(1) = True
    For i = 2 To nCities
        wasVisited(i) = False
    Next

    'Total distance traveled is initially 0. Initial current city is City 1
    totalDistance = 0
    nowAt = 1

    'Find at each step the FARTHEST not-yet-visited city
    For step = 2 To nCities
        'initialize maxDistance to 0
        maxDistance = 0
        For i = 2 To nCities
            If i <> nowAt And Not wasVisited(i) Then
                If distance(nowAt, i) > maxDistance Then
                    nextAt = i
                    maxDistance = TSP.Range("e3").Offset(nowAt, i)
                    'TODO: does this distance call work with the new table format?
                End If
            End If
        Next i
        'store the next city to be visited in the route array
        route(step) = nextAt
        wasVisited(nextAt) = True
        'update total distance travelled
        totalDistance = totalDistance + maxDistance
        'update current city
        nowAt = nextAt
    Next step

    'Update total distance traveled with the distance between the last city visited and the initial city, City 1.
    totalDistance = totalDistance + distance(nowAt, i) 'TODO: does this call work? Original had it as 1, not i.

    'Print Results
    With TSP.Range("A3").Offset(nCities + 2, 0)
        .Offset(0, 0).Value = "Nearest neighbor route"
        .Offset(1, 0).Value = "Stop #"
        .Offset(1, 1).Value = "City"

        For step = 1 To nCities + 1
            .Offset(step + 1, 0).Value = step
            .Offset(step + 1, 1).Value = route(step)
        Next step

        .Offset(nCities + 4, 0).Value = "Total distance is " & totalDistance
    End With
End Sub

I seem to be running into issues with my line "wasVisited(nextAt) = True, where it gives me a subscript out of range. The subscript should here should be firmly within the range i=1 to nCities, and I'm not sure where my issue is coming from. Any ideas?

Answer 1

It's probably not entering the If distance(nowAt, i) > maxDistance Then statement where the nextAt variable is set. So nextAt will still be set to its default value 0 when it reaches that line, which is out of range.

Have you stepped through it with the debugger and checked that it enters this If statement? If you manually set nextAt to a 1 in the Locals window while debugging, does it work then?

If that's the problem, either set an initial value for nextAt outside of the If statement, or ensure that it enters this If statement in its first round in the loop.