Google Maps Travel Time and Distance Calculator for multiple address

[rupertlo]

I have the following code for calculating the Google Maps distance and times between two address.

Sub GoogleMaps()


Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim journey As IXMLDOMNode
Dim RowCount As Integer






RowCount = Worksheets("Calculator").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1


Set myRequest = New XMLHTTP60
myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
& Range("A2").Value & "&destination=" & Range("B2").Value & "&sensor=false", False
myRequest.send
Set myDomDoc = New DOMDocument60
myDomDoc.LoadXML myRequest.responseText
Set journey = myDomDoc.SelectSingleNode("//leg/distance/value")
Set Duration = myDomDoc.SelectSingleNode("//leg/duration/value")


' "//leg/duration/value" Duration in seconds ie "14829". Divide by 60 for minutes etc
' "//leg/duration/text" Duration as text ie "4 hours 7 mins"
' "//leg/distance/value" Distance in meters ie "445295". Divide by 1000 for km etc. To convert to miles devide the km by 1.609344.
' "//leg/distance/text" Distance as text ie "277 miles" (can show in km too)
' "//summary" Route Summary ie "I-80-E" or "M25"


Range("C2").Value = Round(journey.Text / 1000 / 1.609344, 0)
Range("D2").Value = Round(Duration.Text / 60, 0)


exitRoute:


Set journey = Nothing
Set Duration = Nothing
Set myDomDoc = Nothing
Set myRequest = Nothing


End Sub

So, in the VBA above, I type the journey start in cell A2, destination in B2. When I execute the code, the distance appears in cell C2 and travel time appears in D2.

I want to be able to do this for a column of start and destination locations in columns A & B to output in columns C & D. I was thinking of doing a loop function (hence the RowCount line). My question is how do you make A2 become A3, B2 become B3 etc etc for each loop? Many thanks.

 

[mole999]

give people time to respond to your first post before repeating please

 

[Misca]

Here's my take:

Sub GoogleMaps()



Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim journey As IXMLDOMNode
Dim RowCount As Integer


Dim c As Range
Dim Rng As Range


Set Rng = Worksheets("GoogleMaps").Range("A:A").Cells.SpecialCells(xlCellTypeConstants)


'RowCount = Worksheets("GoogleMaps").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1


For Each c In Rng


    With c
    
        Set myRequest = New XMLHTTP60
        myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
        & .Value & "&destination=" & .Offset(, 1).Value & "&sensor=false", False
        myRequest.send
        Set myDomDoc = New DOMDocument60
        myDomDoc.LoadXML myRequest.responseText
        Set journey = myDomDoc.SelectSingleNode("//leg/distance/value")
        Set Duration = myDomDoc.SelectSingleNode("//leg/duration/value")
        
        
        ' "//leg/duration/value" Duration in seconds ie "14829". Divide by 60 for minutes etc
        ' "//leg/duration/text" Duration as text ie "4 hours 7 mins"
        ' "//leg/distance/value" Distance in meters ie "445295". Divide by 1000 for km etc. To convert to miles devide the km by 1.609344.
        ' "//leg/distance/text" Distance as text ie "277 miles" (can show in km too)
        ' "//summary" Route Summary ie "I-80-E" or "M25"
        
        
        .Offset(, 3).Value = Round(journey.Text / 1000 / 1.609344, 0)
        .Offset(, 4).Value = Round(Duration.Text / 60, 0)
        
    End With
    
exitRoute:
    
    
    Set journey = Nothing
    Set Duration = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing




Next c




End Sub

 

[rupertlo]

Thank you Misca...

I am getting a run time error 91 on this line

.Offset(, 3).Value = Round(journey.Text / 1000 / 1.609344, 0)

"Object variable or With block variable not set"

 

[Misca]

I have a feeling you're getting the error because it doesn't find either the c or one of your locations. There's no error handling on the code so you should check what it is it doesn't find. When you get the error hover your mouse on top of c, journey.Text or Duration.Text to see if they exist.

My code is looking for a sheet named GoogleMaps: I was going to change the "Worksheets("GoogleMaps")" to "Activesheet" but l guess I never did.

 

[rupertlo]

I think it may have been something to do with having headers in row 1