I have a VBA macro that uses Microsoft MapPoint to calculate the distance between two locations for each record in my spreadsheet. I have about 120,000 records to process. The program runs smoothly for about 10,000 iterations then returns a Type Mismatch error where I define the MapPoint locations in my error handler. At which point, I select 'Debug' and then resume execution without editing any code, and it will run successfully for another 10,000 or so records before the same thing happens again.
I've checked my data, and I can't see why there would be a type mismatch, or for that matter why the code would choke on a record one time, and then, without resetting anything, handle the same record upon resuming. Any idea why this would happen?
For reference,
- column M contains locations of the form "X County, ST"
- column AN contains a separate location as ZIP
- column G contains the same location data as AN but in the form "X County, ST"
Sub distance_from_res()
Dim oApp As MapPoint.Application
Dim k As Long
Dim count As Long
Dim errors As Long
k = 0
count = Sheets("i1_20041").Range("A2", Sheets("i1_20041").Range("A2").End(xlDown)).count
errors = 0
Set oApp = CreateObject("MapPoint.Application.NA.11")
oApp.Visible = False
Set objMap = oApp.NewMap
Dim objRes As MapPoint.Location
Dim objFish As MapPoint.Location
'Error executes code at 'LocError' and then returns to point of error.
On Error GoTo LocError
Do While k < count
If Sheets("i1_20041").Range("M2").Offset(k, 0) <> "" Then
'Sets MapPoint locations as [County],[State] from Excel sheet columns "INT_CNTY_ST" and "ZIP".
Set objRes = objMap.FindResults(Sheets("i1_20041").Range("AN2").Offset(k, 0)).Item(1)
Set objFish = objMap.FindResults(Sheets("i1_20041").Range("M2").Offset(k, 0)).Item(1)
'Calculates distance between two locations and prints it in appropriate cell in Column AO.
Sheets("i1_20041").Range("AO2").Offset(k, 0) = objRes.DistanceTo(objFish)
Else
errors = errors + 1
End If
k = k + 1
Loop
'Displays appropriate message at termination of program.
If errors = 0 Then
MsgBox ("All distance calculations were successful!")
Else
MsgBox ("Complete! Distance could not be calculated for " & errors & " of " & count & " records.")
End If
Exit Sub
LocError:
If Sheets("i1_20041").Range("G2").Offset(k, 0) = "" Then
errors = errors + 1
Else
'THIS IS WHERE THE ERROR OCCURS!
Set objRes = objMap.FindResults(Sheets("i1_20041").Range("G2").Offset(k, 0)).Item(1)
Set objFish = objMap.FindResults(Sheets("i1_20041").Range("M2").Offset(k, 0)).Item(1)
'Calculates distance between two locations and prints it in appropriate cell in Column AO.
Sheets("i1_20041").Range("AO2").Offset(k, 0) = objRes.DistanceTo(objFish)
End If
k = k + 1
Resume
End Sub
UPDATE: I incorporated most of the suggestions from @winwaed and @Mike D, and my code is now more accurate and doesn't choke on errors. However, the old problem reared its head in a new form. Now, after around 10,000 iterations, the code continues but prints the distance of the ~10,000th record for every record afterwards. I can restart the code at the trouble point, and it will find the distances normally for those records. Why would this happen? I've posted my updated code below.
Sub distance_from_res()
Dim oApp As MapPoint.Application
Dim k As Long
Dim rc As Long
Dim errors As Long
Dim dist As Double
Dim zipRes As Range
Dim coRes As Range
Dim coInt As Range
Dim distR As Range
Set zipRes = Sheets("Sheet1").Range("C2")
Set coRes = Sheets("Sheet1").Range("B2")
Set coInt = Sheets("Sheet1").Range("E2")
Set distR = Sheets("Sheet1").Range("G2")
k = 0
rc = Sheets("Sheet1").Range("F2", Sheets("Sheet1").Range("F2").End(xlDown)).Count
errors = 0
'Start MapPoint application.
Set oApp = CreateObject("MapPoint.Application.NA.11")
oApp.Visible = False
Set objMap = oApp.NewMap
Dim objResultsRes As MapPoint.FindResults
Dim objResultsInt As MapPoint.FindResults
Dim objRes As MapPoint.Location
Dim objInt As MapPoint.Location
Do While k < rc
'Check results for Res Zip Code. If good, set first result to objRes. If not, check results for Res County,ST. If good, set first result to objRes. Else, set objRes to Nothing.
Set objResultsRes = objMap.FindResults(zipRes.Offset(k, 0))
If objResultsRes.ResultsQuality = geoFirstResultGood Then
Set objRes = objResultsRes.Item(1)
Else
Set objResultsRes = Nothing
Set objResultsRes = objMap.FindResults(coRes.Offset(k, 0))
If objResultsRes.ResultsQuality = geoFirstResultGood Then
Set objRes = objResultsRes.Item(1)
Else
If objResultsRes.ResultsQuality = geoAmbiguousResults Then
Set objRes = objResultsRes.Item(1)
Else
Set objRes = Nothing
End If
End If
End If
Set objResultsInt = objMap.FindResults(coInt.Offset(k, 0))
If objResultsInt.ResultsQuality = geoFirstResultGood Then
Set objInt = objResultsInt.Item(1)
Else
If objResultsInt.ResultsQuality = geoAmbiguousResults Then
Set objInt = objResultsInt.Item(1)
Else
Set objInt = Nothing
End If
End If
On Error GoTo ErrDist
distR.Offset(k, 0) = objRes.DistanceTo(objInt)
k = k + 1
Loop
Exit Sub
ErrDist:
errors = errors + 1
Resume Next
End Sub