Calculate Mileage

[kshines]

Wise people of the forum. I am using the VBA below to calculate the distance between two cities. Currently it sends the results to a pop-up message box. How could it be modified to simply put the results in cell B10 of the same worksheet? It also displays in Meters I would like it in Kilometres


Public Function GetDistance(start As String, dest As String)
Dim firstVal As String, secondVal As String, lastVal As String
firstVal = "http://maps.googleapis.com/maps/api/distancematrix/json?origins="
secondVal = "&destinations="
lastVal = "&mode=car&language=pl&sensor=false"
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
URL = firstVal & Replace(start, " ", "+") & secondVal & Replace(dest, " ", "+") & lastVal
objHTTP.Open "GET", URL, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
If InStr(objHTTP.responseText, """distance"" : {") = 0 Then GoTo ErrorHandl
Set regex = CreateObject("VBScript.RegExp"): regex.Pattern = """value"".*?([0-9]+)": regex.Global = False
Set matches = regex.Execute(objHTTP.responseText)
tmpVal = Replace(matches(0).SubMatches(0), ".", Application.International(xlListSeparator))
GetDistance = CDbl(tmpVal)
Exit Function
ErrorHandl:
GetDistance = -1
End Function


Thanks so much in advance.

KH

 

[svendiamond]

When posting VBA code, please use the [ code ] and [ / code] tags (minus the spaces) so that it's easier to read. However, after reading your code I don't see where the message box pops up? This seems to just be the function that gets the result. Is there more code?

 

[cerfani]

that's just a function so you would type it directly into the cell or call it in a macro like any other function

 

[kshines]

Here is the missing VBA you refered to...

Public Function MultiGetDistance(ParamArray args() As Variant) As Double
MultiGetDistance = 0
Dim startLoc As String, endLoc As String, i As Long
For i = LBound(args) To UBound(args) - 1
startLoc = args(i): endLoc = args(i + 1)
MultiGetDistance = MultiGetDistance + GetDistance(startLoc, endLoc)
Next i
End Function

I am trying to get the results to a cell instead of the pop up... hmmm

KH

 

[cerfani]

that is also a function, the macro with the code that calls MsgBox would probably be in a subroutine... it is defined with the keyword Sub...

Sub SomeMacro()
    MsgBox GetMileage("bla bla", "bla bla")
End Sub

change to...

Sub SomeMacro()
    Range("B10").Value2 = GetMileage("bla bla", "bla bla")
End Sub

you just have to do the same in your macro

 

[kshines]

That did it .... Thanks so very much!!
KH

 

[cerfani]

no problem