• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Google distance calculator Table

Yvanchen

New Member
Hello everyone,

First, I'd like to thanks Chandoo because I've found a great and also very simple file to calculate the distances and time with Google Maps in Excel.

I'm trying to improve this file tu be used tu calculate every distance that come in a table when I recieve a Reservation. Unfortunately, my knowledge about excel isn't great with advanced formula and VBA is out of range right now..

I'm trying to make this file with the same logic as Chandoo's file. What I d'like is, when a reservation come, is to calculate the distance and travel time between the adresses who are in the columns M and N.

I have the feeling that it's not that complicated, but I'm stuck on this..

If anyone can give me some advice, I can reward him with a Beer or any other drink (from any online shop!)

Thanks in advance
 

Attachments

  • Distance calculator table.xlsx
    10.4 KB · Views: 15
First, you should read Google API documentation.

There's limit to number of free API usage, they made some changes around June of this year. If your API transaction is less than 25,000 per month, you should be ok, but it still requires that you turn on billing option on in order to use it. And if you go over that limit, it can quickly get expensive.

There are other alternatives as well (such as TomTom that allows for 2,500 request per day for free).

Then, you'd need to obtain your own API key.
Start from link below.
https://developers.google.com/maps/documentation/javascript/get-api-key

For TomTom API follow link below.
https://developer.tomtom.com/

Note: Use of WebService function on Google API isn't recommended. As you can't control number of requests that you make etc.
 
Hello !

Thanks for your answer. I've got the API from google and I saw the change.

Well I'm not living in a big state and we're just build our startup this year, so if 25000 API transaction mean 25'000 Adress calculation, I will be rich as Bill Gates in 3 years haha ! IF 1 API transaction mean 1 search of address to Google (it look like that in my admin console)

For now this is a first and cheap solution. Later I'd like to build something more customizable with professionals.

But I didn't know that we can use TomTom API, I will read also the documentation.
 
With WebService function. I believe each time it's recalculated counts as 1 transaction. So, if you have total of 100 address, but when recalculation is triggered, it sends 100 requests at a time. Even if you've already obtained info before.

I'd recommend building simple VBA module to handle requests. And once info is filled, skip over it. To limit number of requests.
 
I see.

Each file I've tried with VBA never really worked well.. And I've got 0 skills on VBA yet..

Even so, I think the Webservice way for a start will be much easier and may be enough for a while until I've figured it out with VBA. I'll open this file once in a month to do the billing transport, and I clean the informations each month, so it will never have more than 100 lines inside yet. (I don't like big files with thousand and thousand of lines)
Later of course. I'd like to build something far more serious.

Thanks for the link. Yes I've tried this one, and I couldn't make it worked well. I've wrote an E-mail but never got a response..
 
See if you can adopt below.
Code:
Function GetJson(start As String, dest As String)
    Const MyKey As String = "Your_API_KEY_STRING HERE"
    BaseUrl = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    Url2 = "&destinations="
    Url3 = "&language=en&key=" & MyKey
    Url = BaseUrl & Replace(start, " ", "+") & Url2 & Replace(dest, " ", "+") & Url3
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", Url, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .Send
        GetJson = .responseText
    End With
End Function

Sub Demo()
x = GetJson("151 Front Street West, Toronto, ON", "1565 Brittania Rd E, Mississauga, ON")
With CreateObject("VBScript.RegExp")
    .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
    .Global = False
    Set matches = .Execute(x)
    tempDist = matches(0).Submatches(0)
    .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
    Set matches = .Execute(x)
    tempDur = matches(0).Submatches(0)
    Debug.Print "Distance:= " & tempDist / 1000; " Km" & " Duration:= " & tempDur / 60 & " minutes"
End With
End Sub

Put it in Standard Module, and run Demo. See if you get a valid response printed in immediate window.

NOTE: You should replace "Your_API_KEY_STRING HERE" with your actual API Key.

Something like below.
Distance:= 28.855 Km Duration:= 24.0166666666667 minutes

If that works, if you can supply some example in your workbook. I can help further.
 
Last edited:
Wow, much thanks for your work.
I've tried your macro, here is a screen hop I put inside the file.

If I don't put the API, an error come with a printed window, so first good point, when I put the API, and I press F5 to start, I've got nothing...

I've put again the file with your macro and an exemple.
 

Attachments

  • Capture.png
    Capture.png
    392.1 KB · Views: 13
Here you go. Just replace API key with valid one and it will update table with info.

FYI - Since you had API key info in the files. I've removed them from thread. Never share those in public forum. Run GetData sub and you should get response.

Sample result with your example:
upload_2018-10-26_8-57-14.png

Code:
Function GetJson(start As String, dest As String)
    Const MyKey As String = "Key"
    BaseUrl = "https://maps.googleapis.com/maps/api/distancematrix/json?origins="
    Url2 = "&destinations="
    Url3 = "&language=en&key=" & MyKey
    Url = BaseUrl & Replace(start, " ", "+") & Url2 & Replace(dest, " ", "+") & Url3
    With CreateObject("MSXML2.ServerXMLHTTP")
        .Open "GET", Url, False
        .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .Send
        GetJson = .responseText
    End With
End Function

Sub GetData()
Dim cel As Range
For Each cel In Range("Réponses[Adress FROM]").Cells
    If Len(cel.Value) > 0 And Len(cel.Offset(, 2).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value)
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 2).Value = tempDist / 1000
        cel.Offset(, 3).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 3).NumberFormat = "[h]:mm:ss"
    End If
Next
End Sub
 
That's awesome ! It work great !

Is it also to make it a bit more complicated ? For example, sometimes we'll have to take our patient to a secondary destination or so. I've added news columns in the excel to show an example.

If you're interested, I gladly PayPal you for your time, even if it look not so hard to do, it help me a lot.
 

Attachments

  • Distance calculator table VBA.xlsm
    19.9 KB · Views: 7
Are you opposed to changing your table structure a bit?

I'd recommend following structure.

Add ID column, that ties Initial to Return (trips) and keep each "From, To" pair in it's own line.

If there is ever a case, you need to take patient to 3rd destination or more. You'd want to keep data structure consistent for ease of maintenance and further reporting/analysis.

Oh and don't worry about PayPal. I'm bit rusty on Google API, so it's good to brush up on it. I'm active in the forum for my own learning and to help others learn ;)
 
Yes of course, I just did some basic table and linked it to a Jotform.

Not sure if I understood what you mean correctly, I have tried to make an exemple in the file.
 

Attachments

  • Distance calculator table VBA.xlsm
    19.8 KB · Views: 2
What I mean is something like this.
 

Attachments

  • Distance calculator table VBA (2).xlsm
    19.9 KB · Views: 3
I see...

Well statistically speaking, this form of Table says everything.

The purpose of this excel is for Billing the patient, so what is more important is to show total for each patient like my example in this file than all kms and time (but for statistics we'll need this info too).

This way I'll have to rethink the form, because it become far more complexe. Or I ll have to use php language maybe..
 

Attachments

  • Distance calculator table VBA (2).xlsm
    17.9 KB · Views: 2
No need to make table disjointed. Pivot Table is your friend in this.

See Summary sheet in attached.
 

Attachments

  • Distance calculator table VBA (2).xlsm
    25 KB · Views: 1
Yes of course !

I've tried to work on my formular if I can link to this kind of table.. but it will take much work to do.. and I may be limited with structure...

Meanwhile I'm looking to make it work, Is it possible to do it a simpler way ? even if it is just temporary.

I've made an exemple in this file by just adding more columns and then just doing sum of the row. On the macro, is it possible to add more columns ?

Many thanks for your help
 

Attachments

  • Distance calculator table VBA 3.xlsm
    20 KB · Views: 5
I don't get much of your question.

As for if it is possible. Yes, it's possible. However, you'll need to adjust table each time. I'd not recommend it. Another issue, is that if any of the leg in the trip does not query correctly, you'll need to scrap the entire result. Rather than single trip leg.

What's your issue? Detail step by step your issue.
 
Thank you for your answer.

Well, the issue isn't in Excel anymore with the table you propose.
Actually we are not writing directly in Excel, but in form who is being writing in Excel by a workflow.

It's in French, but you can see the kind of form : https://sani-care.ch/reservations/ (but usual things, date, address from -> to, name, etc)

Each completed form = 1 row in excel, and each answer come in a column.
So instead of adding multiple rows for 1 form, I need to add columns. I think until 8 columns are fine, then we can do it manually If needed.

My friend who makes the bills isn't a geek at all, so I wish that when she open Excel with all our reservations list, she can see the name, the address of the patient and how much km we have done, how much time we did the travel, and even how much it costed if we set how much the gazoline cost is.

Like : name : Mr Smith ; home address (for billing) Toronto; Adress from Toronto ; Adress to : Mississauga ; Adress from 2 : Mississauga ; dress to 2 Toronto ; Total Km 58 km : Total Time 100 mn ; total cost : 81.20 $ (if 1.40 $ / L)

So the first solution was really good, but it may be risky for the number of request. Maybe in VBA it works too with the Workflow (like microsoft flow or IFTTT). I can show her how to run the macro, it's only 1 click.
 
Hmm, pivot should be able to give you all that info.

See attached.

If you can't work with that. I'd recommend set up in "Sample" sheet of attached.

Note that code has been modified to reference "Réponses1[Leg1 From]" as starting point.
 

Attachments

  • Distance calculator table VBA_v3.xlsm
    31.3 KB · Views: 4
Yay !! It work !

The summary table is really awesome, I will learn a lot from it !

Just a last request, I've added a few more columns following your logic ( Leg3 To, Leg 3 From, Leg4 from, Leg4 to plus km and time) in my file, but it doesnt fill any info in it. I've tried to look in the macro, but, can't find the place to modify the code.. It really look chinese for me..

I trully thank you for your help.
 

Attachments

  • Réservations Sani-Care.xlsm
    23.8 KB · Views: 1
Since you added 2 extra columns to table before "Leg1 Km" column. You'll need to adjust all the offset values in the code.

Then replicate If... End If block and adjust offset for Leg4.

So something like...
Code:
Sub GetData()
Dim cel As Range
For Each cel In Range("Réponses1[Leg1 From]").Cells
    If Len(cel.Value) > 0 And Len(cel.Offset(, 8).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value)
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 8).Value = tempDist / 1000
        cel.Offset(, 9).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 9).NumberFormat = "[h]:mm:ss"
    End If
    If Len(cel.Offset(, 2).Value) > 0 And Len(cel.Offset(, 10).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value)
        Sheets("Sheet2").Range("A1") = x
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 10).Value = tempDist / 1000
        cel.Offset(, 11).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 11).NumberFormat = "[h]:mm:ss"
    End If
    If Len(cel.Offset(, 4).Value) > 0 And Len(cel.Offset(, 12).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value)
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 12).Value = tempDist / 1000
        cel.Offset(, 13).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 13).NumberFormat = "[h]:mm:ss"
    End If
    If Len(cel.Offset(, 6).Value) > 0 And Len(cel.Offset(, 14).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value)
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 14).Value = tempDist / 1000
        cel.Offset(, 15).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 15).NumberFormat = "[h]:mm:ss"
    End If
Next
End Sub

Edit: you can make it more modular. Using "Leg1 Km" offset in relation to "Leg1 From", you can calculate the rest of offsets.
 
Last edited:
I see! ok I understand how to add rows now.

But I've got an error 9 with the script on the last row of the code :
I tried to change the name of "Sheet2" by the name of my sheet : Réponses.
It worked but got a funny thing also. You can see in the screenshot at A1 Place.
If I tried to create a Sheet2, the answer come in it at A1 also. (you can see the screens I've made)

I don't mind it, but how can i manage this answer a better way? Or do I need it

Code:
Sub GetData()
Dim cel As Range
ForEach cel In Range("Réponses1[Leg1 From]").Cells
   If Len(cel.Value) > 0 And Len(cel.Offset(, 8).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value)
       WithCreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
           Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
           Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
       EndWith
        cel.Offset(, 8).Value = tempDist / 1000
        cel.Offset(, 9).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 9).NumberFormat = "[h]:mm:ss"
   EndIf
   If Len(cel.Offset(, 2).Value) > 0 And Len(cel.Offset(, 10).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value
Sheets("Sheet2").Range("A1") = x


Edit : :

Actually, The script doesn't work.. I see the Kms are the same between each adresses.. I've tried a 80 km and the answer is wrong.. From the office to the patient is 1.6 km then it must be 40km from the patient to hospital, but it say 16 km too.. it take the same answer than Leg1 Km..
 

Attachments

  • Capture d’écran 2018-11-01 à 15.46.06.png
    Capture d’écran 2018-11-01 à 15.46.06.png
    935.1 KB · Views: 8
  • Capture d’écran 2018-11-01 à 15.50.39.png
    Capture d’écran 2018-11-01 à 15.50.39.png
    854.7 KB · Views: 8
Last edited:
I can't replicate your issue on my end.

Upload your sample where you get odd result.

And PM me your API key so I can test.
 
Ah, my bad on that one. I pasted in code that was one version before the final.

Should be...
Code:
Sub GetData()
Dim cel As Range
For Each cel In Range("Réponses[Leg1 From]").Cells
    If Len(cel.Value) > 0 And Len(cel.Offset(, 8).Value) = 0 Then
        x = GetJson(cel.Value, cel.Offset(, 1).Value)
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 8).Value = tempDist / 1000
        cel.Offset(, 9).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 9).NumberFormat = "[h]:mm:ss"
    End If
    If Len(cel.Offset(, 2).Value) > 0 And Len(cel.Offset(, 10).Value) = 0 Then
        x = GetJson(cel.Offset(, 2).Value, cel.Offset(, 3).Value)
        Sheets("Sheet2").Range("A1") = x
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 10).Value = tempDist / 1000
        cel.Offset(, 11).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 11).NumberFormat = "[h]:mm:ss"
    End If
    If Len(cel.Offset(, 4).Value) > 0 And Len(cel.Offset(, 12).Value) = 0 Then
        x = GetJson(cel.Offset(, 4).Value, cel.Offset(, 5).Value)
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 12).Value = tempDist / 1000
        cel.Offset(, 13).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 13).NumberFormat = "[h]:mm:ss"
    End If
    If Len(cel.Offset(, 6).Value) > 0 And Len(cel.Offset(, 14).Value) = 0 Then
        x = GetJson(cel.Offset(, 6).Value, cel.Offset(, 7).Value)
        With CreateObject("VBScript.RegExp")
            .Pattern = "distance(?:.|\n)*?value.+?(\d+)"
            .Global = False
            Set matches = .Execute(x)
            tempDist = matches(0).Submatches(0)
            .Pattern = "duration(?:.|\n)*?value.+?(\d+)"
            Set matches = .Execute(x)
            tempDur = matches(0).Submatches(0)
        End With
        cel.Offset(, 14).Value = tempDist / 1000
        cel.Offset(, 15).Value = tempDur / 60 / 60 / 24
        cel.Offset(, 15).NumberFormat = "[h]:mm:ss"
    End If
Next
End Sub
 
Back
Top