Solved: Total distance and time between two cities in a state

**vishwakarma** · 08-01-2010, 10:14 PM

Hi All,

I want to find the total distance from between two cities in a particular state.

For Example :- Let say I have a list of cities in California like in one column A, and I want to find the total distance and time between Santa Ana and all the cities listed below and paste it the next cell front of the corresponding cities listed.
Column A - - -Column B
Cities - - -Total Travel Estimate:(Distance/Time)
Los Angeles
San Diego
San Jose
San Francisco
Long Beach
Fresno
Sacramento
Oakland

Website :- http://www.mapquest.com/ ( There are three tabs on this page :- Maps, Directions, What’s New); this info can be retrieve from “Directions” tab of the web page…

Also attached is the sheet for reference...

Any help is appreciated..

Thanks in advance

**vishwakarma** · 08-03-2010, 08:35 PM

Hello Guys,

Can any one help me on this?

Sorry... but this is something I really looking forward to.

Thank You...

**Aussiebear** · 08-04-2010, 04:39 AM

Please look at the below link and see if you can copy distances from this site.

http://www.mapcrow.info/united_states.html

**vishwakarma** · 08-05-2010, 03:00 AM

Hi Aussiebear, Thanks for the link....

But this is not what I m looking for. Though with the help of the link I can get the total distance but for a few cities listed on the page. What I need is a code which can copy the data from the excel sheet and visit the site, paste that info in the search page and hit enter and then copy the answers(in this case the distance and time both) in excel in the front of the city name.

My list can contains numerous list of cities segregated by states...

It is not necessary that the website should be the same as I have listed in the earlier post, it can be any other through which we can export the data through this process.

If any one can please help me in getting this data. I will be really grateful.Thanks

**Aussiebear** · 08-05-2010, 03:24 AM

Sorry but i think you need to do more research. This sort of information is already out there, it just needs to be located

**vishwakarma** · 08-06-2010, 02:42 AM

Hello Guys....

Here is what I got after googling. And as I don't have relevant knowledge of VB, I'm not able to figure out what and where is the problem. After pasting this info and activating the "Microsoft DAO 3.6 Object Library" in my excel(2007) on VBA Page. I'm still getting a compile Error saying " User-defined type not defined"... Please Help

[VBA]Public Function GetDistance(startAddr As String, startCity As String, _
startState As String, startZip As String, endAddr As String, _
endCity As String, endState As String, endZip As String) As String

Dim sURL As String
Dim appIE As InternetExplorer
Dim regex As RegExp, Regmatch As MatchCollection
Dim BodyTxt As String
Dim GetFirstPos As Long

sURL = "http://www.mapquest.com/directions?1c=" & Replace(startCity, " ", "+")
sURL = sURL & "&1s=" & startState & "&1a=" & Replace(startAddr, " ", "+")
sURL = sURL & "&1z=" & startZip & "&2c=" & endCity & "&2s=" & endState
sURL = sURL & "&2a=" & Replace(endAddr, " ", "+") & "&2z=" & endZip

Set appIE = New InternetExplorer
'Set appIE = CreateObject("Internetexplorer.application")

appIE.navigate sURL
appIE.Visible = True

Do
DoEvents
Loop Until appIE.readyState = READYSTATE_COMPLETE

appIE.Refresh

Set regex = New RegExp
With regex
.Pattern = "Total Estimated Distance"
.MultiLine = False
End With

BodyTxt = appIE.document.Body.innerText
Set Regmatch = regex.Execute(BodyTxt)

If Regmatch.Count > 0 Then
GetFirstPos = WorksheetFunction.Find("Total Estimated Distance", BodyTxt, 1)

GetDistance = Mid$(BodyTxt, GetFirstPos, 30)

Else
GetDistance = "Address Error, fix and try again"
End If

appIE.Quit
Set appIE = Nothing
Set regex = Nothing
Set Regmatch = Nothing

End Function[/VBA]

**JKwan** · 08-06-2010, 06:47 AM

You need to Reference:
Microsoft Internet Controls
Microsoft VBScript Regular Expressions n.n

**khushii** · 08-08-2010, 09:28 PM

**vishwakarma** · 08-08-2010, 10:11 PM

Thanks JKwan,

However, now I'm facing a new problem. It is giving me #VALUE error as result.

' must set references to Microsoft VBScript Regular Expressions, Internet Controls
' & HTML Object Library before running this script
' based on http://www.vbaexpress.com/kb/getarticle.php?kb_id=386

[VBA]Public Function GetDistance(startAddr As String, startCity As String, _
startState As String, startZip As String, endAddr As String, _
endCity As String, endState As String, endZip As String) As String
Dim sURL As String
Dim appIE As InternetExplorer
Dim regex As RegExp, Regmatch As MatchCollection
Dim BodyTxt As String
Dim GetFirstPos As Long
sURL = "http://www.mapquest.com/maps?1c=" & Replace(startCity, " ", "+")
sURL = sURL & "&1s=" & startState & "&1a=" & Replace(startAddr, " ", "+")
sURL = sURL & "&1z=" & startZip & "&2c=" & endCity & "&2s=" & endState
sURL = sURL & "&2a=" & Replace(endAddr, " ", "+") & "&2z=" & endZip
Set appIE = New InternetExplorer
'Set appIE = CreateObject("Internetexplorer.application")
appIE.navigate sURL
appIE.Visible = False
Do
DoEvents
Loop Until appIE.readyState = READYSTATE_COMPLETE
appIE.Refresh
Set regex = New RegExp
With RegExp
.Pattern = "Total Estimated Distance "
.MultiLine = False
End With
BodyTxt = appIE.document.Body.htmlText
Set Regmatch = regex.Execute(BodyTxt)
If Regmatch.Count > 0 Then
GetFirstPos = WorksheetFunction.Find("Total Estimated Distance", BodyTxt, 1)

GetDistance = Mid$(BodyTxt, GetFirstPos, 30)

Else
GetDistance = "Address Error, fix and try again"
End If
appIE.Quit
Set appIE = Nothing
Set regex = Nothing
Set Regmatch = Nothing
End Function[/VBA]

**Aussiebear** · 08-09-2010, 02:10 AM

When posting code to the forum, please select your code then click the green "VBA" button. I have done this for you on this occassion, and as you can see it formats the code into something easily readable.

**vishwakarma** · 08-09-2010, 02:39 AM

Thanks...

I will keep in mind in future before posting any code...

**JKwan** · 08-09-2010, 07:34 AM

I don't have that problem, after I fixed your RegEx and a few variables errror as well.
[vba]
Public Function GetDistance(startAddr As String, startCity As String, _
startState As String, startZip As String, endAddr As String, _
endCity As String, endState As String, endZip As String) As String
Dim sURL As String
Dim appIE As InternetExplorer
Dim regex As RegExp, Regmatch As MatchCollection
Dim BodyTxt As String
Dim GetFirstPos As Long
sURL = "http://www.mapquest.com/maps?1c=" & Replace(startCity, " ", "+")
sURL = sURL & "&1s=" & startState & "&1a=" & Replace(startAddr, " ", "+")
sURL = sURL & "&1z=" & startZip & "&2c=" & endCity & "&2s=" & endState
sURL = sURL & "&2a=" & Replace(endAddr, " ", "+") & "&2z=" & endZip
Set appIE = New InternetExplorer
'Set appIE = CreateObject("Internetexplorer.application")
appIE.navigate sURL
appIE.Visible = True
Do
DoEvents
Loop Until appIE.readyState = READYSTATE_COMPLETE
appIE.Refresh
Set regex = New RegExp
With regex
.Pattern = "Total Travel Estimate:"
.MultiLine = False
End With
BodyTxt = appIE.document.Body.innerText
Set Regmatch = regex.Execute(BodyTxt)
If Regmatch.Count > 0 Then
GetFirstPos = WorksheetFunction.Find("Total Travel Estimate:", BodyTxt, 1)

GetDistance = Mid$(BodyTxt, GetFirstPos, 50)

Else
GetDistance = "Address Error, fix and try again"
End If
appIE.Quit
Set appIE = Nothing
Set regex = Nothing
Set Regmatch = Nothing
End Function
[/vba]

**vishwakarma** · 08-09-2010, 09:15 PM

Hi JKwan,

I'm still getting the same value error. I think I have not selected the proper references in the vba.

I'm listing the all the references which are selected in VBA of my sheet. I'm using Excel 2007
- Visual Basic for Applications
- Microsoft excel 12.0 Object Library
- Microsoft HTML Object Library
- Microsoft Internet Controls
- Microsoft VBScript Regular Expressions 5.5

Please let me know if I'm doing something wrong. Also, if possible can you please sent me your sample excel file in which you have this code.

Thanks...

**vishwakarma** · 08-10-2010, 12:11 AM

OK Guys,

The code is working fine but there is one issue. I want to autoclick the Message Box that get popped up before the value is pasted in the sheet. Message box displays "Loaded VBAX link". I want it to be autoclicked through VBA so that I don't have to click every time.

Any idea how to do it?

**vishwakarma** · 08-10-2010, 08:54 PM

Hello... sorry to disturb you guys again and again, but can anyone help me on this... I'm attaching my excel sheet for your reference.

The code is running good but I still have a problem with it. Every time I run this UDF. A message box appear (because it is defined in it) and untill and unless I click on this message box it will not return the value. Also, if I click on this a little early it will give me an #VALUE error. I don't want this message box to appear and I get my desired result. Is there any way to do this? ... Thanks..

**Shred Dude** · 08-11-2010, 11:00 PM

You could probably adapt this to other sources, but Google makes it pretty easy.

Try this:

Public Function getGoogDistanceTime(startAddr As String, startCity As String, _
startState As String, startZip As String, endAddr As String, _
endCity As String, endState As String, endZip As String) As String

Dim sURL As String
Dim HTTPreq As Object
Dim BodyTxt As String
Dim s As String, _
    d As String, _
    t As String

sURL = "http://maps.google.com/maps?f=d&source=s_d&saddr="
sURL = sURL & Replace(startAddr, " ", "+") & ",+" & Replace(startCity, " ", "+") & ",+" & startState
sURL = sURL & "&daddr=" & Replace(endAddr, " ", "+") & ",+" & Replace(endCity, " ", "+") & ",+" & endState
sURL = sURL & "&hl=en"

Set HTTPreq = CreateObject("msxml2.xmlhttp")
With HTTPreq
    .Open "get", sURL, False
    .send
    BodyTxt = .responseText
End With
Set HTTPreq = Nothing

s = "distance:"""

If InStr(1, BodyTxt, s) = 0 Then getGoogDistanceTime = "Error": Exit Function

d = Mid(BodyTxt, InStr(1, BodyTxt, s) + Len(s))
d = Mid(d, 1, InStr(1, d, """") - 1)

s = "time:"""
t = Mid(BodyTxt, InStr(1, BodyTxt, s) + Len(s))
t = Mid(t, 1, InStr(1, t, """") - 1)

getGoogDistanceTime = d & " / " & t

End Function

Cleaned it up a little...

[VBA]Public Function getGoogDistanceTime(startAddr As String, startCity As String, _
startState As String, startZip As String, endAddr As String, _
endCity As String, endState As String, endZip As String) As String

Dim sURL As String
Dim BodyTxt As String

sURL = "http://maps.google.com/maps?f=d&source=s_d&saddr="
sURL = sURL & Replace(startAddr, " ", "+") & ",+" & Replace(startCity, " ", "+") & ",+" & startState
sURL = sURL & "&daddr=" & Replace(endAddr, " ", "+") & ",+" & Replace(endCity, " ", "+") & ",+" & endState
sURL = sURL & "&hl=en"

BodyTxt = getHTML(sURL)

If InStr(1, BodyTxt, "distance:""") = 0 Then getGoogDistanceTime = "Error": Exit Function

getGoogDistanceTime = parseGoog("distance", BodyTxt) & " / " & parseGoog("time", BodyTxt)

End Function

Public Function getHTML(strURL As String) As String
'Returns the HTML code underlying a given URL
Dim oXH As Object
Set oXH = CreateObject("msxml2.xmlhttp")
With oXH
.Open "get", strURL, False
.send
getHTML = .responseText
End With
Set oXH = Nothing
End Function

Public Function parseGoog(strSearch As String, strHTML As String) As String
strSearch = strSearch & ":"""
If InStr(1, strHTML, strSearch) = 0 Then parseGoog = "Not Found": Exit Function
parseGoog = Mid(strHTML, InStr(1, strHTML, strSearch) + Len(strSearch))
parseGoog = Mid(parseGoog, 1, InStr(1, parseGoog, """") - 1)
End Function[/VBA]

**vishwakarma** · 08-12-2010, 12:32 AM

Awesome Man....

This is working like a magic..

Thanks a lot....

Manoj

**Morglam** · 02-04-2011, 10:52 AM

Hi,

Just wanted to say that this code has saved my life with my thesis work...thanks a lot!

However, I just wanted to know if is possible to just give to the formula the geographical coordinates (google maps easily recognizes them) instead of the 4 fields (adress, city, state, code) and what changes shoud I do to the code.

Thanks in advance, nice work!

**JP2112** · 02-04-2011, 12:33 PM

Maybe something from Latitude Longitude Functions can help?

**Morglam** · 02-05-2011, 03:32 AM

Thanks for the tip. Unfortunately, I think that it doesn't show how to calculate the driving distance with two geographical coordinates given, just with the adressses.

With the adresses the code works just fine but most of the places I need to geolocate are in tracks with no adress, so the accuracy of my work is affected. I'm no VBA expert, so maybe it's easy to combine some codes but it will be a nightmare for me.

Any help is really welcomed!

Thread: Solved: Total distance and time between two cities in a state

Thread Tools

Display

Solved: Total distance and time between two cities in a state

Another approach, using Google Maps

Posting Permissions