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?