Google Earth: determine which points are inside a polygon using coordinates

[chrism216]

Hi everyone,

This is not really a question, but rather something I had needed for some time, did some research and for which I eventually came up with an excel-based solution.

In work I came across the problem of having to calculate work loads for several work groups, based on the geographical location of the places they needed to go. For that, I needed to know which points were inside which polygons.

I made a workbook which can test whether a point(s) is inside a polygon(s). This solution does not need any online "KML" generators or file interpreters. All you need is Excel and your KML file with the polygons.

Thanks to Rick Rothstein and user sijpie, who got me on the right track with this thread:
http://www.mrexcel.com/forum/excel-...lygon-visual-basic-applications-function.html

INSTRUCTIONS:
1. Download the workbook here: https://www.dropbox.com/s/707qslttz428v6w/PointInPolygon.xlsm?dl=0
2. In Google Earth, draw all the polygons you want to test. Put them all in the same folder.
3. Right-click the folder and click "Save As". Save it in the same directory as the Excel file, with the name "Polygons". Choose the format .kml (very important!)
4. Put all the coordinates you want to test on the columns B and C on the first and only sheet in the workbook. Coordinates must be in decimal format, like this: 40.689397 and -74.045036. You can add a Name on column A, though this is optional.
5. Click Analyze.

The workbook will output a matrix filled with True/False. Each column represents one of the polygons you drew on Google Earth, and for each row, you will know in which polygon(s) a point is.

Hopefully this helps someone out there. For any questions, I'll be glad to help.

Cheers,

Chris

 

[nelwood]

Hi Chris,
I am super excited about finding this thread on point in polygon. I've been trying to use it but I keep running into a Run Time Error. It says "Run-time error. '9' Subscript out of range." When I click debug it takes me to the visual basic editor and points to a line that says "Workbooks("PointInPolygon.xlsm").Activate." I hope that is enough to know what might be happening. Any help would be greatly appreciated.

-Nate

 

[chrism216]

Hi Nelwood

The only think I can think of is that you saved the file using a different name.

When you save the workbook, be sure to save it under the name PointInPolygon, with the .xlsm extension (excel with enabled macros). Also, make sure that both files (PointInPolygon.xlsm, Polygons.kml) are in the same directory.

Hope it helps!

 

[Custom1]

This looks immensely helpful, however I am getting the error:
'Run-time error '1004': That name is already Taken. Try a different one.

When I debug, I am taken to this line of the 'Addsheet' code:
Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).name = mySheet

I'd greatly appreciate any assistance troubleshooting,

Thanks

 

[Rick Rothstein]

This looks immensely helpful, however I am getting the error:
'Run-time error '1004': That name is already Taken. Try a different one.

When I debug, I am taken to this line of the 'Addsheet' code:
Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).name = mySheet

That means that whatever text is assigned to the variable mySheet is already the name of an existing worksheet. How are you determining what text to assign to your my Sheet variable (maybe showing us your code would help)?

 

[Custom1]

Here is the code - it is the code in the workbook downloaded from the original post.

Public Sub Main()

Dim myDir As String
Dim kml As String
Dim xml As String
Dim myData As Variant
Dim myNames As Variant

path = Application.ActiveWorkbook.path
kml = "Polygons.kml"
xml = "Polygons.xml"

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Kill old XML
If Len(Dir$(path & "\" & xml)) > 0 Then
     Kill path & "\" & xml
End If

'Copy KML file and rename to .XML
If Len(Dir$(path & "\" & kml)) = 0 Then
     MsgBox _
     "Necessary polygon KML file" & _
     vbNewLine & _
     vbNewLine & _
     kml & _
     vbNewLine & _
     vbNewLine & _
     " was not found in directory " & _
     vbNewLine & _
     vbNewLine & _
     path & "." & _
     vbNewLine & _
     vbNewLine
     Exit Sub
End If
FileCopy path & "\" & kml, path & "\" & xml

'Open new XML
Application.Workbooks.OpenXML (path & "\" & xml)

'Extract data and close
For i = 1 To ActiveSheet.UsedRange.Columns.Count
    If InStr(1, Cells(2, i), "Placemark/name") <> 0 Then 'Find polygon names
        myNames = Range(Cells(3, i), Cells(3, i).End(xlDown)).Value
        Exit For
    End If
Next i

For i = 1 To ActiveSheet.UsedRange.Columns.Count
    If InStr(1, Cells(2, i), "coordinates") <> 0 Then 'Find polygon coordinates
        myData = Range(Cells(3, i), Cells(3, i).End(xlDown)).Value
        Exit For
    End If
Next i
ActiveWorkbook.Close
Workbooks("PointInPolygon.xlsm").Activate

'Clear Sheets and columns
For i = 2 To Sheets.Count
    Sheets(2).Delete
Next i
Sheets("PolygonContains").Range("D:DZ").Delete

'Import coordinates into Sheets
For i = 1 To UBound(myData, 1)
    Call GetCoord(myNames(i, 1), myData(i, 1))
Next i

'Run analysis
Call PointInPolygon.PolyQuery

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Worksheets("PolygonContains").Activate
Range("A2").Select
End Sub

Private Sub GetCoord(ByVal mySheet As String, ByVal myString As String)
'From XML, extract polygon name and coordinate data
Call AddSheet(mySheet)
Dim RowContent As Variant 'contains rows still in CSV format
Dim coord As Double

'Split string
RowContent = Split(myString, " ")
For i = 0 To UBound(RowContent)
    For j = 0 To 1
        Sheets(mySheet).Cells(i + 1, -j + 2).Value = CDbl(Split(RowContent(i), ",")(j)) '-j+2 because Lat/Lon are reversed
    Next j
Next i

End Sub

Private Sub AddSheet(ByVal mySheet As String)
    Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).name = mySheet
    Sheets(mySheet).Visible = xlSheetHidden
End Sub

 

[Rick Rothstein]

Here is the code - it is the code in the workbook downloaded from the original post.

In the Main subroutine, you load up the myNames array with the names of the polygons, then you call the GetCoord subroutine passing each myName array element to it... the GetCoord subroutine then turns around and calls the AddSheet subroutine using the polygon name for the name of the new worksheet it adds. Given the error message you are getting, I can only conclude that there is one or more existing sheets in the workbook with the name of one or more of the polygons.... perhaps from a previous running of the code when the polygons were first processed? You need to take steps to make sure that the polygon names do not match an existing worksheet name.

 

[chrism216]

Here is the code - it is the code in the workbook downloaded from the original post.

Public Sub Main()

Dim myDir As String
Dim kml As String
Dim xml As String
Dim myData As Variant
Dim myNames As Variant

path = Application.ActiveWorkbook.path
kml = "Polygons.kml"
xml = "Polygons.xml"

Application.DisplayAlerts = False
Application.ScreenUpdating = False

'Kill old XML
If Len(Dir$(path & "\" & xml)) > 0 Then
     Kill path & "\" & xml
End If

'Copy KML file and rename to .XML
If Len(Dir$(path & "\" & kml)) = 0 Then
     MsgBox _
     "Necessary polygon KML file" & _
     vbNewLine & _
     vbNewLine & _
     kml & _
     vbNewLine & _
     vbNewLine & _
     " was not found in directory " & _
     vbNewLine & _
     vbNewLine & _
     path & "." & _
     vbNewLine & _
     vbNewLine
     Exit Sub
End If
FileCopy path & "\" & kml, path & "\" & xml

'Open new XML
Application.Workbooks.OpenXML (path & "\" & xml)

'Extract data and close
For i = 1 To ActiveSheet.UsedRange.Columns.Count
    If InStr(1, Cells(2, i), "Placemark/name") <> 0 Then 'Find polygon names
        myNames = Range(Cells(3, i), Cells(3, i).End(xlDown)).Value
        Exit For
    End If
Next i

For i = 1 To ActiveSheet.UsedRange.Columns.Count
    If InStr(1, Cells(2, i), "coordinates") <> 0 Then 'Find polygon coordinates
        myData = Range(Cells(3, i), Cells(3, i).End(xlDown)).Value
        Exit For
    End If
Next i
ActiveWorkbook.Close
Workbooks("PointInPolygon.xlsm").Activate

'Clear Sheets and columns
For i = 2 To Sheets.Count
    Sheets(2).Delete
Next i
Sheets("PolygonContains").Range("D:DZ").Delete

'Import coordinates into Sheets
For i = 1 To UBound(myData, 1)
    Call GetCoord(myNames(i, 1), myData(i, 1))
Next i

'Run analysis
Call PointInPolygon.PolyQuery

Application.DisplayAlerts = True
Application.ScreenUpdating = True

Worksheets("PolygonContains").Activate
Range("A2").Select
End Sub

Private Sub GetCoord(ByVal mySheet As String, ByVal myString As String)
'From XML, extract polygon name and coordinate data
Call AddSheet(mySheet)
Dim RowContent As Variant 'contains rows still in CSV format
Dim coord As Double

'Split string
RowContent = Split(myString, " ")
For i = 0 To UBound(RowContent)
    For j = 0 To 1
        Sheets(mySheet).Cells(i + 1, -j + 2).Value = CDbl(Split(RowContent(i), ",")(j)) '-j+2 because Lat/Lon are reversed
    Next j
Next i

End Sub

Private Sub AddSheet(ByVal mySheet As String)
    Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).name = mySheet
    Sheets(mySheet).Visible = xlSheetHidden
End Sub

This is almost certainly because you are naming 2 polygons with the same name in google earth.

This would give an error because behind the scenes, this program fetches the data from the KML file and pastes it into hidden sheets, naming each one with the same name as the polygon. Previous runs dont matter, at the beginning of the sub i erase all sheets

Cheers

 

[Custom1]

This is almost certainly because you are naming 2 polygons with the same name in google earth.

This would give an error because behind the scenes, this program fetches the data from the KML file and pastes it into hidden sheets, naming each one with the same name as the polygon. Previous runs dont matter, at the beginning of the sub i erase all sheets

Cheers

I don't think that is the issue because there is only one polygon in the Google Earth Folder I saved as KML. Docs at below link.

https://www.dropbox.com/sh/w9iq089jwwjzjo4/AAAV02RDC_fzsuonFK6f27Jsa?dl=0

I'm super eager to get this working as I have over 5,000 records to parse. Any help would be appreciated.

 

[Custom1]

May be a Google Earth bug. I have deleted, redrawn and re-saved the polygon and KML file multiple times, but it appears Google Earth keeps putting out the same data.

 

[chrism216]

May be a Google Earth bug. I have deleted, redrawn and re-saved the polygon and KML file multiple times, but it appears Google Earth keeps putting out the same data.

Ok, ive seen that happen sometimes. After all, the way i extract the data from the kml file is pretty much a caveman approach. I will do it manually and get back to you tomorrow because im out of office, should be pretty easy.
Cheers

Chris