I have this Sub in VBA Excel and I have everything figured out except how to add
ID: 3600263 • Letter: I
Question
I have this Sub in VBA Excel and I have everything figured out except how to add this:
This is what I have so far:
Option Explicit
Sub EX8_2_2NearestNeighbor()
Dim iSeg As Integer, i As Integer, j As Integer, iStart As Integer
Dim nCities As Integer, nowAt As Integer, nextC As Integer
Dim intTD As Integer, intMaxDist As Integer, intMinDist As Integer
Dim rngA As Range
Dim Dist() As Integer
Dim blnVisited() As Boolean
Set rngA = Range("A3")
With rngA
'Find nCities
nCities = .CurrentRegion.Rows.Count - 1
'redim Dist() and blnVisited()
ReDim Dist(1 To nCities, 1 To nCities)
ReDim blnVisited(1 To nCities)
'read Distance matrix from Excel, assign to Dist()
For i = 1 To nCities
For j = 1 To nCities
Dist(i, j) = .Offset(i, j)
Next j
Next i
'Finding the longest distance and assign to variable intMaxDist
'Mark all cities unvisited
intMaxDist = 0
For i = 1 To nCities
blnVisited(i) = False
For j = i + 1 To nCities
If Dist(i, j) > intMaxDist Then intMaxDist = Dist(i, j)
Next j
Next i
'Write Output Headings
.Offset(nCities + 2, 0) = "From"
.Offset(nCities + 3, 0) = "To"
.Offset(nCities + 4, 0) = "Distance"
.Offset(nCities + 5, 0) = "Total Distance"
'initialize total distance intTD
'Define iStart = Starting City Number
'Use city 1 as the starting city (iStart),
intTD = 0
iStart = 1: blnVisited(iStart) = True
'Cycle through all cities to find nearest neighbor excluding already visited cities
'Report back to excel the optimal route
' Current segment starting city (nowAT)
nowAt = iStart
For iSeg = 1 To nCities - 1
intMinDist = intMaxDist
For i = 1 To nCities
If Not blnVisited(i) And Dist(nowAt, i) < intMinDist Then
intMinDist = Dist(nowAt, i)
nextC = i
End If
Next i
blnVisited(nextC) = True
intTD = intTD + intMinDist
.Offset(nCities + 2, iSeg) = nowAt
.Offset(nCities + 3, iSeg) = nextC
.Offset(nCities + 4, iSeg) = intMinDist
.Offset(nCities + 5, iSeg) = intTD
nowAt = nextC
Next iSeg
.Offset(nCities + 2, nCities) = nextC
.Offset(nCities + 3, iSeg) = iStart
.Offset(nCities + 4, iSeg) = Dist(nextC, iStart)
.Offset(nCities + 5, iSeg) = intTD + Dist(nextC, iStart)
End With
End Sub
If anyone knows how to add what I cannot figure out I'd greatly appreciate it! Thank you!!
a. First allow user to identify starting city (iStart) b. Loop through all possible starting cities (1 to nCities) and pick the shortest total distance routeExplanation / Answer
Dim iSeg As Integer, i As Integer, j As Integer, iStart As Integer
Dim nCities As Integer, nowAt As Integer, nextC As Integer
Dim intTD As Integer, intMaxDist As Integer, intMinDist As Integer
Dim rngA As Range
Dim Dist() As Integer
Dim blnVisited() As Boolean
Set rngA = Range("A3")
With rngA
'Find nCities
nCities = .CurrentRegion.Rows.Count - 1
'redim Dist() and blnVisited()
ReDim Dist(1 To nCities, 1 To nCities)
ReDim blnVisited(1 To nCities)
'read Distance matrix from Excel, assign to Dist()
For i = 1 To nCities
For j = 1 To nCities
Dist(i, j) = .Offset(i, j)
Next j
Next i
'Finding the longest distance and assign to variable intMaxDist
'Mark all cities unvisited
intMaxDist = 0
For i = 1 To nCities
blnVisited(i) = False
For j = i + 1 To nCities
If Dist(i, j) > intMaxDist Then intMaxDist = Dist(i, j)
Next j
Next i
'Write Output Headings
.Offset(nCities + 2, 0) = "From"
.Offset(nCities + 3, 0) = "To"
.Offset(nCities + 4, 0) = "Distance"
.Offset(nCities + 5, 0) = "Total Distance"
'initialize total distance intTD
'Define iStart = Starting City Number
'Use city 1 as the starting city (iStart),
intTD = 0
iStart = 1: blnVisited(iStart) = True
'Cycle through all cities to find nearest neighbor excluding already visited cities
'Report back to excel the optimal route
' Current segment starting city (nowAT)
nowAt = iStart