Find distances between locations in bulk

Use google Maps API to find distances between locations

Problem Statement

I've come across a situation where a business client of mine needed to find the distance between a source location to multiple destinations.

There were hundreds of destinations, and so this is no easy task to do manually.

As I did this some time back, I've forgotten the original sources from which I learnt the method. I apologize to them for not citing the references.

Solution

I snooped around online for a way to find the distances, and after getting a fair idea of how google maps works, I was able to put together this macro.

First, create a properly formatted Excel sheet like so:

The first three columns are details of the origin, while the next three columns are details of the destinations.

You can add or remove the number of columns depending on the precision you require.

The seventh column is for displaying the calculated distances.

Open up the VBA editor through 'Alt-F11' and add a new module.

Paste the following code:

Sub getDistances()

Dim xhrRequest As XMLHTTP60

Dim domDoc As DOMDocument60

Dim ixnlDistanceNodes As IXMLDOMNodeList

Dim ixnNode As IXMLDOMNode

Dim lOutputRow As Long

Dim dist As Double

dist = 0

Dim LastRow As Integer

Dim i As Integer

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

For i = 2 To LastRow Step 1

    ' Read the data from the website

    Set xhrRequest = New XMLHTTP60

    xhrRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" & Range("A" & i).Value & "+" & Range("B" & i).Value & "+" & Range("C" & i).Value & "&destination=" & Range("D" & i).Value & "+" & Range("E" & i).Value & "+" & Range("F" & i).Value & "&sensor=false", False

    xhrRequest.send

    

    ' Copy the results into a format we can manipulate with XPath

    Set domDoc = New DOMDocument60

    domDoc.LoadXML xhrRequest.responseText

    

    ' The important bit: select every node called "value" which is the child of a node called "distance" which is

    ' in turn the child of a node called "step"

    Set ixnlDistanceNodes = domDoc.SelectNodes("//step/distance/value")

    

    ' Basic stuff to output the distances

    lOutputRow = 1

    

        For Each ixnNode In ixnlDistanceNodes

            dist = dist + Val(ixnNode.Text)

        Next ixnNode

    

    

    Cells(i, 7).Value = dist / 1000

    

    Set ixnNode = Nothing

    Set ixnlDistanceNodes = Nothing

    Set domDoc = Nothing

    Set xhrRequest = Nothing

    dist = 0

   

   'Give enough time for the data to come back

    Application.Wait Now + TimeSerial(0, 0, 1)

    

Next i

End Sub

Aaaaaand... we're done!

Run the "getDistances" macro, sit back and relax while the distances are being populated.

The End.

Merge multiple PDF files using VBA, Excel and PDFtk

Merge PDF files based on their names

The problem statement

I have come across a situation where I needed to merge thousands of pairs of PDF files, based on their filenames. This blog outlines the method I used.

There are a set of PDF files with this naming convention: ABCDEFGHIJ_2013-14.pdf

Here "ABCDEFGHIJ" is the part of the file name which varies from file to file.

Let us call this set of files "SET A".

There is a second set of files with this naming convention: 00012345_ABCDEFGHIJ_2012.pdf

Here, "00012345_ABCDEFGHIJ" is the variable part.

This set of files will be called "SET B".

Files from each set, which have the common field "ABCDEFGHIJ" need to be merged.

The format of merged file will be "00012345_ABCDEFGHIJ_2013-14.pdf"

Tools you'll need

• Microsoft Excel with VBA installed
• PDFtk, a free tool from PDF Labs ( Get it here: http://www.pdflabs.com/tools/pdftk-the-pdf-toolkit/)

The method

First of all, let's get things organized.

Create a folder in your computer and name it "PDF Merge".

In it, create two folders "SET A" and "SET B". Next, create a folder "Merging Area" within "PDF Merge".

"Merging area" will the the folder where the actual merging will take place.

Put all files in their respective folders.

Install PDFtk.

This is a PDF manipulation tool which has a command-line interface.

Create an Excel file in the "PDF Merge" folder. Open it up, and save it it as a macro-enabled workbook (.xlsm).

In the workbook, rename the first sheet as "Main" and second sheet as "Paths".

Fill in the fields as shown, and edit the paths to the ones relevant to you, but make sure the order is same as shown.

Press Alt-F11 to enter VBA editor.

Go to Tools->References and enable 'Microsoft Scripting Runtime'. Press OK.

Add a new module and insert the following code:

Option Explicit

Sub MatchFiles()

'create a new file system object

Dim fso As New FileSystemObject

Dim fol As Folder

Dim fil As File

Dim i As Integer

'now get a pointer to SET A

Set fol = fso.GetFolder(Worksheets("Paths").Range("B3").Value & "\")

'now loop over all of the files in the folder

Worksheets("Main").Select

i = 1

For Each fil In fol.Files

    Range("A" & i).Value = fil.Name

    i = i + 1

   fil.Copy Worksheets("Paths").Range("B1").Value & "\" & fil.Name, True

Next fil

'now get a pointer to SET B

Set fol = fso.GetFolder(Worksheets("Paths").Range("B2").Value & "\")

Dim cellname As Range

Worksheets("Main").Select

Range("A1").Select

If Range("A2").Value <> "" Then

Range(ActiveCell, ActiveCell.End(xlDown)).Select

End If

'Match files based on file name

For Each cellname In Selection

    For Each fil In fol.Files

        If StrComp(Mid(fil.Name, 10, 10), Mid(cellname.Value, 1, 10)) = 0 Then

            cellname.Offset(0, 1).Value = fil.Name

            fil.Copy Worksheets("Paths").Range("B1").Value & "\" & fil.Name

        End If

    Next fil

Next cellname

Call Make_Text

End Sub

Insert a new Module and paste the following code:

Option Explicit

Sub Make_Text()

'Create a text file from the 3rd column values

    Dim i As Long, myDir As String, temp, x As Long

    myDir = Worksheets("Paths").Range("B1").Value & Application.PathSeparator

    With Range("a1").CurrentRegion

        For i = 1 To .Columns.Count

            x = Application.CountA(.Columns(3))

            temp = Application.Transpose(.Cells(1, 3).Resize(x).Value)

            Open myDir & .Cells(1, 3).Text & ".txt" For Output As #1

            Print #1, Join(temp, vbCrLf)

            Close #1

        Next

    End With

    

Call rename_file

End Sub

Insert a third Module and paste the following code:

Option Explicit

Sub rename_file()

'Rename the text file to a batch file

Dim fso As New FileSystemObject

Dim fol As Folder

Set fol = fso.GetFolder(Worksheets("Paths").Range("B1").Value)

Dim fil As File

For Each fil In fol.Files

    If Right(fil.Name, 3) = "txt" Then

        fil.Name = "Run to merge.bat"

        Exit For

    End If

Next fil

End Sub

Creating the command-line calls

In the cell "C1" of "Main" sheet, insert this formula:

=IF(B1 <> "","pdftk A=" & A1 & " B=" & B1 & " cat A B output "  & MID(B1,1,9) & MID(A1,1,11) & "2013-14.pdf","")

This is the format required to use PDFtk to merge two files. You can visit their website to see other advanced methods to suit your needs.

After inputting it, use Autofill to fill the formula in as many cells as required.

Aaaand... we're done!

After you run the macro called "MatchFiles", you'll find all the matched files and a batch file named "Run to Merge.bat" inside the "Merging Area" folder.

Double-click this file to merge the files in the same folder. The output files will be in the same folder. You can segregate them from the input files by sorting the files by Date Modified.

Conclusion

Here I have accounted for scenarios where the count of files in SET A and SET B might differ, which was the situation I faced.

Go through the code carefully and see what changes you need to make to adapt it to your scenario.

Do comment with any suggestions or queries.