PDA

View Full Version : VBA: Macro Fails When More Than One Error



nickshep85
02-21-2013, 02:30 AM
I have the below code which looks at a list of postcodes that I have in my Excel (2003) sheet and then tells me the nearest Item to that postcode. It is worth mentioning that I have removed any pre-defined items, such as restaurants and train stations, so that the only items on the Map are my own Pushpins.

I have built in an On Error line to skip any rows where MapPoint (2006) cannot find the postcode, however, I have noticed that this only works if there is only one error in the list of postcodes. If I have more than one error then the Macro will fail.

Can someone please help me out here as I cannot figure out why this keeps failing on me if there are two or more errors.

Thanks in advance,




Private Const TotCentre = 3

Sub FindNearbyPlaces()

'Dim objApp As New MapPoint.Application
Dim objMap As MapPoint.Map
Dim objNearby As MapPoint.Waypoint
Dim objLoc1 As MapPoint.Location
Dim sent As MapPoint.Location
Dim Centre As String
Dim NumCentre, NumCol, Itm As Integer


Application.ScreenUpdating = False

Set objApp = CreateObject("Mappoint.Application.EU.13")
objApp.Visible = False
Set objMap = objApp.OpenMap("C:\Program Files\Microsoft MapPoint Europe\Centres By Type.ptm", False)
'objApp.UserControl = True

Sheets("RUN").Columns("B:J").Select
Selection.ClearContents
Sheets("RUN").Cells(1, 1).Select

'Insert Column Headers
Sheets("RUN").Cells(1, 2).Value = "Nearest Centre"
Sheets("RUN").Cells(1, 3).Value = "Centre Type"
Sheets("RUN").Cells(1, 4).Value = "Centre Code"
Sheets("RUN").Cells(1, 5).Value = "2nd Nearest Centre"
Sheets("RUN").Cells(1, 6).Value = "Centre Type"
Sheets("RUN").Cells(1, 7).Value = "Centre Code"
Sheets("RUN").Cells(1, 8).Value = "3rd Nearest Centre"
Sheets("RUN").Cells(1, 9).Value = "Centre Type"
Sheets("RUN").Cells(1, 10).Value = "Centre Code"

nreadrow = 2


Do While Sheets("RUN").Cells(nreadrow, 1) <> ""
On Error GoTo Skip
NumCol = 2

'Locate Start Point
Itm = 1
Set objLoc1 = objMap.FindResults(Sheets("RUN").Cells(nreadrow, 1)).Item(Itm)
For NumCentre = 1 To TotCentre

'Find 3 Nearest Centres Up To 50 Miles from Location & Show Results In Spreadsheet

Sheets("RUN").Cells(nreadrow, NumCol) = objLoc1.FindNearby(50).Item(Itm).Name
Centre = Sheets("RUN").Cells(nreadrow, NumCol)
Sheets("RUN").Cells(nreadrow, NumCol + 1).FormulaR1C1 = "=VLOOKUP(" & Chr(34) & Centre & Chr(34) & ",LOOKUP!C1:C12,6,0)"
Sheets("RUN").Cells(nreadrow, NumCol + 2).FormulaR1C1 = "=VLOOKUP(" & Chr(34) & Centre & Chr(34) & ",LOOKUP!C1:C12,12,0)"
NumCol = NumCol + 3
Itm = Itm + 1

'Sheets("RUN").Cells(nreadrow, 5) = objLoc1.FindNearby(50).Item(2).Name
'Centre 2 = Sheets("RUN").Cells(nreadrow, 5)
'Sheets("RUN").Cells(nreadrow, 8) = objLoc1.FindNearby(50).Item(3).Name
'Centre 3 = Sheets("RUN").Cells(nreadrow, 8)

Next

Skip:
nreadrow = nreadrow + 1
Loop

objApp.Quit

Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.Goto Reference:="R1C1"
Application.CutCopyMode = False
Cells(1, 1).Select

Application.ScreenUpdating = True
MsgBox "Event Complete"


End Sub

Eric Frost
02-21-2013, 10:06 AM
Hi Nick, welcome back to the forums! This is your first post in over 2.5 years? :-)

Did you see our recent newsletter? What's New at MP2K Magazine (http://www.mp2kmag.com/update/mappoint.newsletter/2013-02-18/)

That looks OK to me.. I guess I'd have to see it in action to figure out what's happening and why it's failing.

Just to ensure it's only going to skip when the error is on the zip code lookup you might rearrange the On Error like this:



Do While Sheets("RUN").Cells(nreadrow, 1) <> ""
NumCol = 2
'Locate Start Point
Itm = 1
On Error GoTo Skip
Set objLoc1 = objMap.FindResults(Sheets("RUN").Cells(nreadrow, 1)).Item(Itm)
On Error Goto 0
For NumCentre = 1 To TotCentre


This way, if there in an error anywhere else, it's not going to jump to Skip:, and you will see if there is an error being generated by anything else in the code.

hope this helps!
Eric

nickshep85
02-22-2013, 01:18 AM
Hi Eric,

I've been putting this project on the back-burner for a while now, but it's become necessary to revisit this macro to cut out hours of manual work.

I've tried amending the code, but this makes the macro stop at the first error. With the original code, it skipped my first error, but then stopped when it reached the second error.

When I click Debug, with either version of my code, it shows the line:
Sheets("RUN").Cells(nreadrow, NumCol) = objLoc1.FindNearby(50).Item(Itm).Name

I am assuming that this is because it cannot find the postcode, therefore it cannot find any Item within 50 Miles of it.

Eric Frost
02-22-2013, 10:01 AM
I don't know.. because if it couldn't find a Location, it would have skipped this portion of the code.

I am thinking it simply didn't find 3 centres within 50 miles of the postcode?

What is the value of Itm when it fails?

Did you try this manually to verify it does have three centres within 50 miles of this postcode?

Eric

Swoop
03-01-2013, 07:59 AM
Don't know if this'll help or not but.......I've had to set up an additional section of code in my projects that runs when MapPoint errors and can't find a postcode.....I have an access database with every single postcode in the UK and it's corresponding grid ref, when MapPoint errors the code will look up the grid ref of the failing postcode and all other postcodes with a grid ref that starts with the same 3 digits.......find the one with the least difference to the original and try again....repeating until it finds one that MapPoint doesn't error on.

Drop me a PM if you'd like a copy of the db.

Eric Frost
03-01-2013, 09:31 AM
Would you be interested in publishing as a brief How To or article?

Thanks!
Eric

Swoop
03-01-2013, 09:43 AM
Sure but I can't say when I'll find the time.

nickshep85
03-04-2013, 04:52 AM
I've managed to figure out with a little help that my error checking was stuck in the loop, rather than sending my code to skip the line. Thanks for your help guys

Eric Frost
03-04-2013, 10:19 AM
Ah that makes sense, glad you figured it out!

Eric