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.

 

[pbornemeier]

Option Explicit  'is always good to include to catch variable typos and omissions

Sub GoogleMaps()

    Dim myRequest As XMLHTTP60
    Dim myDomDoc As DOMDocument60
    Dim journey As IXMLDOMNode
    Dim duration As IXMLDOMNode
    Dim RowCount As Integer
    Dim lLastRow As Long
    Dim sAValue As String
    Dim sBValue As String
    Dim lX As Long
    Dim rngConstants As Range
    Dim rngCell As Range
    
    'Include VBE reference to Microsoft XML, v6.0 , using Tools | References
    
    'Using SpecialCells(xlCellTypeConstants) not good since
    'RowCount = Worksheets("Calculator").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1
    
    With Worksheets("Calculator")
        lLastRow = .Range("A:A").Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    Set rngConstants = Worksheets("Calculator").Cells.SpecialCells(xlCellTypeConstants)
    For Each rngCell In Intersect(ActiveSheet.Columns(1), ActiveSheet.UsedRange.Cells.SpecialCells(xlCellTypeConstants))
        sAValue = rngCell.Value
        sBValue = rngCell.Offset(0, 1).Value
    
        Set myRequest = New XMLHTTP60
            myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
            & sAValue & "&destination=" & sBValue & "&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"
        
        rngCell.Offset(0, 2).Value = Round(journey.Text / 1000 / 1.609344, 0)
        rngCell.Offset(0, 3).Value = Round(duration.Text / 60, 0)
    Next
    
exitRoute:
    
    Set journey = Nothing
    Set duration = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing

End Sub

originally I wanted to use a loop that started as follows, but I could not get the cells containing constants to behave as I thought they should so I changed to above code

    Set rngConstants = Worksheets("Calculator").Cells.SpecialCells(xlCellTypeConstants)
    For lX = 2 To lLastRow  'Iterate all rows in range from 2 to last row
        If Intersect(Worksheets("Calculator").Range("A" & lX), rngConstants).Cells.Count = 1 Then  'Only process constants

 

[pauleverton]

Option Explicit  'is always good to include to catch variable typos and omissions

Sub GoogleMaps()

    Dim myRequest As XMLHTTP60
    Dim myDomDoc As DOMDocument60
    Dim journey As IXMLDOMNode
    Dim duration As IXMLDOMNode
    Dim RowCount As Integer
    Dim lLastRow As Long
    Dim sAValue As String
    Dim sBValue As String
    Dim lX As Long
    Dim rngConstants As Range
    Dim rngCell As Range
    
    'Include VBE reference to Microsoft XML, v6.0 , using Tools | References
    
    'Using SpecialCells(xlCellTypeConstants) not good since
    'RowCount = Worksheets("Calculator").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1
    
    With Worksheets("Calculator")
        lLastRow = .Range("A:A").Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    Set rngConstants = Worksheets("Calculator").Cells.SpecialCells(xlCellTypeConstants)
    For Each rngCell In Intersect(ActiveSheet.Columns(1), ActiveSheet.UsedRange.Cells.SpecialCells(xlCellTypeConstants))
        sAValue = rngCell.Value
        sBValue = rngCell.Offset(0, 1).Value
    
        Set myRequest = New XMLHTTP60
            myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
            & sAValue & "&destination=" & sBValue & "&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"
        
        rngCell.Offset(0, 2).Value = Round(journey.Text / 1000 / 1.609344, 0)
        rngCell.Offset(0, 3).Value = Round(duration.Text / 60, 0)
    Next
    
exitRoute:
    
    Set journey = Nothing
    Set duration = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing

End Sub

originally I wanted to use a loop that started as follows, but I could not get the cells containing constants to behave as I thought they should so I changed to above code

    Set rngConstants = Worksheets("Calculator").Cells.SpecialCells(xlCellTypeConstants)
    For lX = 2 To lLastRow  'Iterate all rows in range from 2 to last row
        If Intersect(Worksheets("Calculator").Range("A" & lX), rngConstants).Cells.Count = 1 Then  'Only process constants

This is coming up with an error on the below line, any reason why?


rngCell.Offset(0, 2).Value = Round(journey.Text / 1000 / 1.609344, 0)</pre>

Thanks,

Paul

 

[pauleverton]

This is coming up with an error on the below line, any reason why?


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

Thanks,

Paul

Ignore me, sorted it!

Thanks