MapPoint

[jrodon]

Is anyone familiar with writing VBA in Excel that works with MapPoint in the background?

I have a map containing membership per zipcode (about 60,000 zipcodes are being used). This map also contains around 800 pushpins. Each pushpin will then have a 10 mile radius drawn around it. I am trying to determine the best way to bring back the membership for each pushpin within the 10 mile range...

 

[Harlech]

Here are 3 subroutines that should get you started. The idea is to run them via command buttons from Sheet1. For the first one you need to have a MapPoint map open with your 800 pushpins plotted. It will then draw a 10-mile radius circle around each pushpin.

[FONT=Calibri][SIZE=3]Private Sub DrawCircles_Click()[/SIZE][/FONT]
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>
[SIZE=3][FONT=Calibri] Dim objMap As MapPoint.Map[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objDataSet As MapPoint.DataSet[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objDataSets As MapPoint.DataSets[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objRecords As MapPoint.Recordset[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objPin As MapPoint.Pushpin[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objLoc As MapPoint.Location[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objShape As MapPoint.Shape[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim Ws As Excel.Worksheet[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim intPushpinCount As Integer[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim strPushpinSet As String[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  ‘Assumes MapPoint NA 2009[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set objMap = GetObject(, "MapPoint.Application.NA.16").ActiveMap[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set Ws = Sheets("Sheet1")[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Ws.Range("D3").Select[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ActiveCell.Value = "Current Shape"[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set objDataSets = objMap.DataSets[/FONT][/SIZE]
 
[FONT=Calibri][SIZE=3]'*****************************************************************************[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]   strPushpinSet = "Pushpin Set Name" 'Enter name of pushpin set here[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]'*****************************************************************************[/SIZE][/FONT]
 
[SIZE=3][FONT=Calibri]   For Each objDataSet In objDataSets[/FONT][/SIZE]
<o:p></o:p>
[SIZE=3][FONT=Calibri]       If objDataSet.Name = strPushpinSet Then[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]         Set objRecords = objDataSet.QueryAllRecords[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]         objRecords.MoveFirst[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]         intPushpinCount = 0[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]           Do Until objRecords.EOF()[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]               If objRecords.IsMatched Then[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 intPushpinCount = intPushpinCount + 1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 Set objPin = objRecords.Pushpin[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 Set objLoc = objPin.Location[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 ' Specify circle attributes[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 Set objShape = objMap.Shapes.AddShape _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                                (geoShapeOval, objLoc, 20#, 20#)[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 objShape.Name = objPin.Name & "_10m Circle"[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 objShape.SizeVisible = False[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 objShape.Fill.Visible = False[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 objShape.Fill.ForeColor = vbRed[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 objShape.Line.ForeColor = vbBlack[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 objShape.Line.Weight = 2[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 ' Keep count of number of circles[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 Ws.Range("E3").Select[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                 ActiveCell.Value = intPushpinCount[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]               End If[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]            objRecords.MoveNext[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           Loop[/FONT][/SIZE]
<o:p></o:p>
[SIZE=3][FONT=Calibri]       Else[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       End If[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]   Next[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]  MsgBox (intPushpinCount & _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           " circles have been added to your active MapPoint map")[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]End Sub[/SIZE][/FONT]

The second subroutine deletes all the circles on the live map (very useful)

[FONT=Calibri][SIZE=3]Private Sub DeleteCircles_Click()[/SIZE][/FONT]
 
[SIZE=3][FONT=Calibri] Dim objMap As MapPoint.Map[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objShapes As MapPoint.Shapes[/FONT][/SIZE]
[SIZE=3][FONT=Calibri] Dim objShape As MapPoint.Shape[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]   Set objMap = GetObject(, "MapPoint.Application.NA.16").ActiveMap[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Set objShapes = objMap.Shapes[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]    For Each objShape In objShapes[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       If objShape.Type = geoAutoShape Then objShape.Delete[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    Next[/FONT][/SIZE]
<o:p></o:p>
[FONT=Calibri][SIZE=3]End Sub[/SIZE][/FONT]

The third one adds up the number of members per zip falling in each 10-mile radius and outputs the values to Sheet1. The circles are given the names of the pushpin. You need to have a map open with the 800 circles and the membership data already input via the Import Data Wizard in the format zip code ID, Membership number. This data then has to be plotted as pushpins (very important for this to work) which will draw a pushpin at the centroid of each zip.

[FONT=Calibri][SIZE=3]Private Sub GetData_Click()[/SIZE][/FONT]
 
[SIZE=3][FONT=Calibri]Dim objMap As MapPoint.Map[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim objDataSet As MapPoint.DataSet[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim objDataSets As MapPoint.DataSets[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim objShape As MapPoint.Shape[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim objRecords As MapPoint.Recordset[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim objFields As MapPoint.Fields[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim Ws As Excel.Worksheet[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim lngCount As Long, NRow As Integer, ShapeCount As Integer, _[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]    TotShapes As Integer[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim Measure As Double[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]Dim strMappedData As String[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]  Set Ws = Sheets("Sheet1")[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Ws.Select[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Cells.Select[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Selection.ClearContents[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Range("A1").Select[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ActiveCell.Value = "Circle Name"[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Range("B1").Select[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ActiveCell.Value = "Number of Zips"[/FONT][/SIZE]
<o:p></o:p>
[SIZE=3][FONT=Calibri]   lngCount = 0[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   NRow = 1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   ShapeCount = 1[/FONT][/SIZE]
<o:p></o:p>
[SIZE=3][FONT=Calibri]  Set objMap = GetObject(, "MapPoint.Application.NA.16").ActiveMap[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  Set objDataSets = objMap.DataSets[/FONT][/SIZE]
<o:p></o:p>
[SIZE=3][FONT=Calibri]  TotShapes = objMap.Shapes.Count[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  Do While ShapeCount <= TotShapes[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]    Set objShape = objMap.Shapes.Item(ShapeCount)[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]'*****************************************************************************[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]    strMappedData = "NameMappedData" 'Enter name of mapped data set here[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]'*****************************************************************************[/SIZE][/FONT]
[SIZE=3][FONT=Calibri]       For Each objDataSet In objDataSets[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]           If objDataSet.Name = strMappedData Then[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]              NRow = NRow + 1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]              Ws.Cells(NRow, 1).Value = objShape.Name[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]              Set objRecords = objDataSet.QueryShape(objShape)[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]              objRecords.MoveFirst[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]                Do While Not objRecords.EOF[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   lngCount = lngCount + 1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   objRecords.MoveNext[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                Loop[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]                If lngCount = 0 Then[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   Measure = 0#[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                Else[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   lngCount = 0[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   objRecords.MoveFirst[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   Set objFields = objRecords.Fields[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   Ws.Cells(1, 3) = objFields(2).Name[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                   Measure = 0#[/FONT][/SIZE]
 
[SIZE=3][FONT=Calibri]                       Do While Not objRecords.EOF[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                          Set objFields = objRecords.Fields[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                          lngCount = lngCount + 1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                          ‘Specify field to be aggregated   [/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                          Measure = Measure + objFields(2).Value[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                          objRecords.MoveNext[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                       Loop[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]                End If[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]             Ws.Cells(NRow, 2).Value = lngCount[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]             Ws.Cells(NRow, 3).Value = Measure[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]             lngCount = 0[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]           End If[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]       Next[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]     ShapeCount = ShapeCount + 1[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]   Loop[/FONT][/SIZE]
[SIZE=3][FONT=Calibri]  MsgBox "Data collation completed for " & ShapeCount & " circles."[/FONT][/SIZE]
[FONT=Calibri][SIZE=3]End Sub[/SIZE][/FONT]

This is barebones code. There’s no error handling. Also be mindful that the MapPoint point-in-polygon aggregation procedure isn’t 100% robust and points (zip centroids) close to the edge are sometimes missed out. Also a zip is only included if the centroid falls in the circle – this can lead to a situation where although much of the area of the zip falls in the circle it isn’t included because the centroid is outside. It may be better to work with a slightly larger radius eg. 11 miles. Also I haven’t tested the code in detail so you need to check the output!
Anyway have fun and pm me with any problems.

 

[jrodon]

Thanks a ton for the reply, I really didn't think anyone would be able to help me out on here... I'll give this a shot tomorrow.