Shortest Flow Layout Solver - vba

Question

I have a routing sequence for a set of machines on an assembly line. Each route has to go through the entire line (that is, if you only run the first and second machine, you still account for the distance from the second to the end of the line).
I have six different machines (720 possible combinations of machines) with fixed distances between each location on the line. The distance between the first and second machine is 100', the distance between second and third is 75', third and fourth is 75', fourth and fifth is 25', and fifth and sixth is 25'.
I have 4 different products that have to run down the line, and each of them have a fixed routing.
My problem is, how do I set up a vba code or solver that will allow me to run through all possible combinations of the line setup and determine the optimal setup for this line? Any machine can be placed at any location, as long as it optimizes the result!
The four product routes are :
A - B - C - D - F
A - C - B - D – E - F
A - F - E - D - C - B - A - F
A - C - E - B - D – F

Answer 1

Running through all possible combinations - if you really need to do that - is a job for something like Heap's algorithm, although I prefer the plain changes method:
Sub Evaluate(Lineup() As String)
' dummy evaluation, just output the permutation
Dim OffCell As Long
For OffCell = LBound(Lineup, 1) To UBound(Lineup, 1)
ActiveCell.Offset(0, OffCell).Value = Lineup(OffCell)
Next OffCell
ActiveCell.Offset(1, 0).Activate
End Sub
Sub AllPerms(Lineup() As String)
' Lineup is a 1-D array indexed at 1
Dim LSize As Long
Dim Shift() As Long
Dim Tot As Long
Dim Idx As Long
Dim Level As Long
Dim Change As Long
Dim Offset As Long
Dim TempStr As String
LSize = UBound(Lineup)
ReDim Shift(LSize)
'count of permutations, set initial changes
Tot = 1
For Idx = 2 To LSize
Tot = Tot * Idx
Shift(Idx) = 1 - Idx
Next Idx
Shift(1) = 2 ' end condition
' go through permutations
For Idx = 1 To Tot
' check this one
Call Evaluate(Lineup)
' switch for the next
Level = LSize
Offset = 0
Change = Abs(Shift(Level))
Do While Change = 0 Or Change = Level
If Change = 0 Then Shift(Level) = 1: Offset = Offset + 1
If Change = Level Then Shift(Level) = 1 - Level
Level = Level - 1
Change = Abs(Shift(Level))
Loop
Shift(Level) = Shift(Level) + 1
Change = Change + Offset
TempStr = Lineup(Change)
Lineup(Change) = Lineup(Change + 1)
Lineup(Change + 1) = TempStr
Next Idx
End Sub
Sub ABCDEF_case()
Dim LU(6) As String
LU(1) = "A"
LU(2) = "B"
LU(3) = "C"
LU(4) = "D"
LU(5) = "E"
LU(6) = "F"
Call AllPerms(LU)
End Sub