finding all available routings/paths

[akramer08]

I will try to keep this a simple as possible. I have a sheet with a list of flights, the origin of the flight in column A and the destination of the flight in column B. I want to be able to type in an origin and destination in lets say cells F1 and G1, and have a macro determine all possible routings since there is most likely no direct connection.

For example using the table below, if I typed in PDX to BRU, I would want to show three routing combinations;

1. PDX-CVG-BRU
2. PDX-CVG-LEJ-BRU
3. PDX-SEA-CVG-BRU
4. PDX-SEA-CVG-LEJ-BRU

Origin	Destination
PDX	SEA
SEA	CVG
CVG	LEJ
CVG	BRU
LEJ	BRU
PDX	CVG

<tbody>
</tbody>

 

[akramer08]

The only problem with that process is there are flights in AND out of every city. So if I am selecting BRU as my chosen endpoint, there will be multiple ways of reaching that destination. However, the master list of flights will also list flights that originate at BRU. So if there is a way to set the destination to a user defined string the same way "PDX" was defined as the origin within the code then I think this would be the solution.

 

[MickG]

You would need to ensure that the starting place and destination where never in the same column by modifying the master list.
Then run the code, Then eliminate the Points you don't want.
.

 

[akramer08]

I seem to have one issue left (or at least I hope only one). The code will get stuck in a loop if there is a way to backtrack. For instance, using the first table below as the master list, the code will get stuck going back and forth between CVG and LEJ as shown below as well. How can I alter the code to not allow it to backtrack?

Master list:

Org	Dst
PDX	SEA
SEA	CVG
CVG	LEJ
PDX	CVG
CVG	BRU
LEJ	BRU
LEJ	CVG

<colgroup><col width="64" span="2" style="width:48pt"> </colgroup><tbody>
</tbody>

Routings:

PDX

SEA

CVG

LEJ

BRU

PDX

SEA

CVG

LEJ

CVG

LEJ

BRU

PDX

SEA

CVG

LEJ

CVG

LEJ

CVG

LEJ

BRU

PDX

SEA

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

BRU

PDX

SEA

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

BRU

PDX

SEA

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

BRU

PDX

SEA

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

BRU

PDX

SEA

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

CVG

LEJ

BRU

<colgroup><col width="64" span="19" style="width:48pt"> </colgroup><tbody>
</tbody>

 

[MickG]

If possible I would try to ensure your basic data does not contain what appear to be potential continuous loop such as
"CVG-LEJ" and "LEJ-CVG". if that is not possible you could try the code below which should remove those extra lines like "LEJ -CVG" in the basic data, then run the other code.

[COLOR="Navy"]Sub[/COLOR] MG14Apr53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] nRng [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Txt1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Txt2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
        Txt1 = Dn.Value & " " & Dn.Offset(, 1).Value
        Txt2 = Dn.Offset(, 1).Value & " " & Dn.Value
        [COLOR="Navy"]If[/COLOR] Not .exists(Txt1) And Not .exists(Txt2) [COLOR="Navy"]Then[/COLOR]
            .Add Txt1, Dn
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    Txt = Dn.Value & " " & Dn.Offset(, 1).Value
        [COLOR="Navy"]If[/COLOR] Not .exists(Txt) [COLOR="Navy"]Then[/COLOR]
            [COLOR="Navy"]If[/COLOR] nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] [COLOR="Navy"]Set[/COLOR] nRng = Dn Else [COLOR="Navy"]Set[/COLOR] nRng = Union(nRng, Dn)
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]If[/COLOR] Not nRng [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR] nRng.EntireRow.Delete
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]

Regards Mick

 

[akramer08]

Mick,

That doesnt seem to be the solution. The code will output different results depending on the order of the table before the code is initiated. I get this data supplied to me and i cannot verify the order the data is in every time it is given to me as it will be a few hundred routes. Is there no way for the original code to not allow the same airport code 2 times in the same route or path?

 

[MickG]

Removing the extra "LEJ-CVG", returned the following:-

PDX SEA CVG LEJ BRU
PDX SEA CVG BRU
PDX CVG LEJ BRU
PDX CVG BRU

What part of that did not work for you ???

If the data does not proceed in a parent child relationship and has parts that return directly back to the Parent , then unfortunately this code is not going to do.
Perhaps a further example of your data with its pitfalls would make it more apparent !!!

 

[akramer08]

The part that did not work is that the output is completely different depending on the original order of the table before the code is ran. Depending on the original order of the table, the code will delete either "LEJ-CVG" or "CVG-LEJ". Whichever is found on the table first will remain, while the second is deleted. If it deletes "CVG-LEJ", then "PDX SEA CVG LEJ BRU" and "PDX CVG LEJ BRU" will not show as a possibility.

There doesnt seem to be a logical order i can arrange the table in for this to be the solution.

 

[akramer08]

Does any one have any ideas on this?

 

[akramer08]

I know this may be from 2 months ago, but does any one have any ideas?