• 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.

Grouping of geo points (Latitude & longtitute)

Sujay

New Member
Hi Guys,
I have been trying to find some resource on Internet to group the latitute and longtitude.
I have a set of co-ordinates (lat & long) we need to group them based on the distance. All the points which are within 5 KM radius should be grouped. I have all the data in excel.
Does anyone know how to do this using VBA by integrating with google map?
Regards
Sujay
 
I did something similar some time ago, this is the code i managed to put together. GetDistance returns the distance between StartPoint and EndPoint (in Km). I recall i rearranged the code from a website that claimed to be run by "someplace" police :)

You need to add reference to Microsoft XML 6

HTH


Code:
Public Function GetDistance(StartPoint As String, EndPoint As String) As Double

Dim myXMLReq As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim distNode As IXMLDOMNode
  GetDistance = 0

  On Error GoTo errhandl
  SPoint = URLEncode(StartPoint)
  EPoint = URLEncode(EndPoint)

  Set myXMLReq = New XMLHTTP60
  myXMLReq.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
  & SPoint & "&destination=" & EPoint & "&sensor=false", False
  myXMLReq.send

  Set myDomDoc = New DOMDocument60
  myDomDoc.LoadXML myXMLReq.responseText

  Set distNode = myDomDoc.SelectSingleNode("//leg/distance/value")
  If Not distNode Is Nothing Then GetDistance = distNode.Text / 1000

errhandl:

  Set distNode = Nothing
  Set myDomDoc = Nothing
  Set myXMLReq = Nothing
End Function

Private Function URLEncode(StrVal As String, Optional boolSpace As Boolean = False) As String
  Dim StrLen As Long
  StrLen = Len(StrVal)

  If StrLen > 0 Then
  ReDim result(StrLen) As String
  Dim i As Long, ChrCode As Integer
  Dim MidChr As String, ChrSpace As String

  If boolSpace Then ChrSpace= "+" Else ChrSpace= "%20"

  For i = 1 To StrLen
  MidChr = Mid$(StrVal, i, 1)
  ChrCode = Asc(MidChr)

  Select Case ChrCode
  Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
  result(i) = MidChr
  Case 32
  result(i) = ChrSpace
  Case 0 To 15
  result(i) = "%0" & Hex(ChrCode)
  Case Else
  result(i) = "%" & Hex(ChrCode)
  End Select
  Next i
  URLEncode = Join(result, "")
  End If
End Function
 
Last edited:
Back
Top