VBA: Calculate the distance between two cities in a board

[Ruben1629]

Hi guys,

I have a board with a list of cities and I need to create a distance function on VBA that would calculate the distance between these two cities.

I am having a hard time finding where to start, any help would be welcomed

Here is the board:

Angers

Bordeaux

Caen

Calais

Lille

Lyon

Marseille

Nantes

Nice

Paris

Rennes

Strasbourg

Toulouse

Villes1

Angers

0​

398​

255​

512​

521​

597​

905​

91​

1062​

297​

127​

777​

637​

Bordeaux

398​

0​

617​

874​

806​

556​

645​

353​

802​

590​

472​

945​

246​

Caen

255​

617​

0​

347​

388​

693​

1002​

290​

1159​

234​

183​

739​

845​

Calais

512​

874​

347​

0​

110​

759​

1069​

598​

1226​

293​

526​

621​

963​

Lille

521​

806​

388​

110​

0​

691​

1001​

600​

1158​

225​

569​

554​

895​

Lyon

597​

556​

693​

759​

691​

0​

314​

684​

471​

466​

740​

487​

537​

Marseille

905​

645​

1002​

1069​

1001​

314​

0​

985​

199​

775​

1050​

798​

403​

Nantes

91​

353​

290​

598​

600​

684​

985​

0​

1143​

385​

113​

865​

586​

Nice

1062​

802​

1159​

1226​

1158​

471​

199​

1143​

0​

932​

1207​

785​

560​

Paris

297​

590​

234​

293​

225​

466​

775​

385​

932​

0​

353​

491​

679​

Rennes

127​

472​

183​

526​

569​

740​

1050​

113​

1207​

353​

0​

830​

700​

Strasbourg

777​

945​

739​

621​

554​

487​

798​

865​

785​

491​

830​

0​

971​

Toulouse

637​

246​

845​

963​

895​

537​

403​

586​

560​

679​

700​

971​

0​

 

[mumps]

The data in your post was misaligned. Try the macro on the data below:

Villes1	Angers	Bordeaux	Caen	Calais	Lille	Lyon	Marseille	Nantes	Nice	Paris	Rennes	Strasbourg	Toulouse
Angers	0	398	255	512	521	597	905	91	1062	297	127	777	637
Bordeaux	398	0	617	874	806	556	645	353	802	590	472	945	246
Caen	255	617	0	347	388	693	1002	290	1159	234	183	739	845
Calais	512	874	347	0	110	759	1069	598	1226	293	526	621	963
Lille	521	806	388	110	0	691	1001	600	1158	225	569	554	895
Lyon	597	556	693	759	691	0	314	684	471	466	740	487	537
Marseille	905	645	1002	1069	1001	314	0	985	199	775	1050	798	403
Nantes	91	353	290	598	600	684	985	0	1143	385	113	865	586
Nice	1062	802	1159	1226	1158	471	199	1143	0	932	1207	785	560
Paris	297	590	234	293	225	466	775	385	932	0	353	491	679
Rennes	127	472	183	526	569	740	1050	113	1207	353	0	830	700
Strasbourg	777	945	739	621	554	487	798	865	785	491	830	0	971
Toulouse	637	246	845	963	895	537	403	586	560	679	700	971	0

Option Compare Text
Sub getDistance()
    Application.ScreenUpdating = False
    Dim LastRow As Long, city1 As String, city2 As String, fnd1 As Range, fnd2 As Range
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    city1 = InputBox("Enter the name of the first city.")
    If city1 = "" Then Exit Sub
    Set fnd1 = Rows(1).Find(city1, LookIn:=xlValues, lookat:=xlWhole)
    If fnd1 Is Nothing Then
         MsgBox (city1 & " was not found.  Please try again.")
         Exit Sub
    End If
    city2 = InputBox("Enter the name of the second city.")
    If city2 = "" Then Exit Sub
    If city1 = city2 Then
        MsgBox ("You have entered the same 'start' and 'end' cities." & Chr(10) & "Please try again.")
        Exit Sub
    End If
    Set fnd2 = Range("A:A").Find(city2, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd2 Is Nothing Then
        MsgBox ("The distance between " & city1 & " " & city2 & " is " & Cells(fnd2.Row, fnd1.Column) & " kilometers.")
    Else
        MsgBox (city2 & " was not found.  Please try again.")
    End If
    Application.ScreenUpdating = True
End Sub

 

[Ruben1629]

The data in your post was misaligned. Try the macro on the data below:

Villes1	Angers	Bordeaux	Caen	Calais	Lille	Lyon	Marseille	Nantes	Nice	Paris	Rennes	Strasbourg	Toulouse
Angers	0	398	255	512	521	597	905	91	1062	297	127	777	637
Bordeaux	398	0	617	874	806	556	645	353	802	590	472	945	246
Caen	255	617	0	347	388	693	1002	290	1159	234	183	739	845
Calais	512	874	347	0	110	759	1069	598	1226	293	526	621	963
Lille	521	806	388	110	0	691	1001	600	1158	225	569	554	895
Lyon	597	556	693	759	691	0	314	684	471	466	740	487	537
Marseille	905	645	1002	1069	1001	314	0	985	199	775	1050	798	403
Nantes	91	353	290	598	600	684	985	0	1143	385	113	865	586
Nice	1062	802	1159	1226	1158	471	199	1143	0	932	1207	785	560
Paris	297	590	234	293	225	466	775	385	932	0	353	491	679
Rennes	127	472	183	526	569	740	1050	113	1207	353	0	830	700
Strasbourg	777	945	739	621	554	487	798	865	785	491	830	0	971
Toulouse	637	246	845	963	895	537	403	586	560	679	700	971	0

Option Compare Text
Sub getDistance()
    Application.ScreenUpdating = False
    Dim LastRow As Long, city1 As String, city2 As String, fnd1 As Range, fnd2 As Range
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    city1 = InputBox("Enter the name of the first city.")
    If city1 = "" Then Exit Sub
    Set fnd1 = Rows(1).Find(city1, LookIn:=xlValues, lookat:=xlWhole)
    If fnd1 Is Nothing Then
         MsgBox (city1 & " was not found.  Please try again.")
         Exit Sub
    End If
    city2 = InputBox("Enter the name of the second city.")
    If city2 = "" Then Exit Sub
    If city1 = city2 Then
        MsgBox ("You have entered the same 'start' and 'end' cities." & Chr(10) & "Please try again.")
        Exit Sub
    End If
    Set fnd2 = Range("A:A").Find(city2, LookIn:=xlValues, lookat:=xlWhole)
    If Not fnd2 Is Nothing Then
        MsgBox ("The distance between " & city1 & " " & city2 & " is " & Cells(fnd2.Row, fnd1.Column) & " kilometers.")
    Else
        MsgBox (city2 & " was not found.  Please try again.")
    End If
    Application.ScreenUpdating = True
End Sub

it worked, thank you so much!

 

[mumps]

You are very welcome.

 

[Fluff]

If your interested, you could also do this with a formula

+Fluff 1.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Villes1	Angers	Bordeaux	Caen	Calais	Lille	Lyon	Marseille	Nantes	Nice	Paris	Rennes	Strasbourg	Toulouse
2	Angers	0	398	255	512	521	597	905	91	1062	297	127	777	637		Caen	1159
3	Bordeaux	398	0	617	874	806	556	645	353	802	590	472	945	246		Nice
4	Caen	255	617	0	347	388	693	1002	290	1159	234	183	739	845
5	Calais	512	874	347	0	110	759	1069	598	1226	293	526	621	963
6	Lille	521	806	388	110	0	691	1001	600	1158	225	569	554	895
7	Lyon	597	556	693	759	691	0	314	684	471	466	740	487	537
8	Marseille	905	645	1002	1069	1001	314	0	985	199	775	1050	798	403
9	Nantes	91	353	290	598	600	684	985	0	1143	385	113	865	586
10	Nice	1062	802	1159	1226	1158	471	199	1143	0	932	1207	785	560
11	Paris	297	590	234	293	225	466	775	385	932	0	353	491	679
12	Rennes	127	472	183	526	569	740	1050	113	1207	353	0	830	700
13	Strasbourg	777	945	739	621	554	487	798	865	785	491	830	0	971
14	Toulouse	637	246	845	963	895	537	403	586	560	679	700	971	0
Data

Cell Formulas
Range	Formula
Q2	Q2	=INDEX(B2:N14,MATCH(P2,A2:A14,0),MATCH(P3,B1:N1,0))