calc sales within x-mile radius using trig function - lat and long

[Keizai]

I am trying to write code for Excel 2007 that will calculate a variable which sums the sales of all competing businesses within a 2 mile radius. I want to do this for 7,678 businesses in my dataset. The formula to evaluate the distances between businesses uses latitude and longitude points - I have tested this formula using two businesses (the formula used in my 'if -then' statement) and it is accurate. I am trying, however, to write code to evaluate the entire array of businesses for each individual data point to create this new field for all observations.

I have been getting different errors and tweaking my code to fix them, but I have come to a point where I need help. My last error is a run-time error '438' - "object doesn't support this property or method'. I will paste my code below (the error refers to my 'If' statement). i and j are the rows = business units, column A has latitudes, B has longitudes, F is sales and H will have my new variable (total sales of businesses within 2 miles).


Sub Compet()

Dim i As Integer
Dim j As Integer
Dim RangeSum As Long

RangeSum = 0
i = 2
j = 2

Do Until j > 7678

Do Until i > 7678
Worksheets("infotest").Select
If (Application.WorksheetFunction.Acos(Application.WorksheetFunction.Sin((3.14 159 / 180) * Range("A" & j).Value) _
* Application.WorksheetFunction.Sin((3.14159 / 180) * Range("A" & i).Value) + Application.WorksheetFunction.Cos((3.14159 / 180) _
* Range("A" & j).Value) * Application.WorksheetFunction.Cos((3.14159 / 180) * Range("A" & i).Value) _
* (Application.WorksheetFunction.Cos((3.14159 / 180) * Range("B" & j).Value - (3.14159 / 180) _
* Range("B" & i).Value))) * 3959) < 2 Then
RangeSum = RangeSum + Worksheets("infotest").Range("F" & i).Value
End If
i = i + 1
Loop
Worksheets("infotest").Range("h" & j).Select
ActiveCell.Print RangeSum
RangeSum = 0
i = 2
j = j + 1
Loop


End Sub

sorry my formula is sloppy - the indenting didn't come out like the module.

any help is much appreciated!!

[mikerickson]

The first thing that I notice is that Cos and Sin are VBA functions, but not members of the WorksheetFunctions collection.
Also there is a worksheet function Pi(). Introducing some variables would make the first If statement much easier to edit. (I also applied some trig)

[VBA]Dim aiAngle As Double, ajangle As Double, biAngle As Double, bjAngle As Double

aiAngle = Application.Pi() * Range("A" & i).Value / 180
ajangle = Application.Pi() * Range("A" & j).Value / 180
biAngle = Application.Pi() * Range("B" & i).Value / 180
bjAngle = Application.Pi() * Range("B" & j).Value / 180

If (Application.WorksheetFunction.ACos(Sin(ajangle + aiAngle) * Cos(biAngle - bjAngle)) * 3959) Then[/VBA]

[Keizai]

your method worked for getting past the bug in my 'if' statement, thanks!!

(but I think my parameters are off, but we will see once the code is bug free)

I am having problems finding the option to print my RangeSum variable to the ("H" & j) cell.

Here is the complete updated code:



Sub Compet()

Dim i As Integer
Dim j As Integer
Dim RangeSum As Long
Dim aiAngle As Double
Dim ajAngle As Double
Dim biAngle As Double
Dim bjAngle As Double


RangeSum = 0
i = 2
j = 2
aiAngle = Application.Pi() * Range("A" & i).Value / 180
ajAngle = Application.Pi() * Range("A" & j).Value / 180
biAngle = Application.Pi() * Range("B" & i).Value / 180
bjAngle = Application.Pi() * Range("B" & j).Value / 180

Do Until j > 7678

Do Until i > 7678
Worksheets("infotest").Select
If (Application.WorksheetFunction.Acos(Sin(ajAngle) * Sin(aiAngle) _
+ Cos(ajAngle) * Cos(aiAngle) _
* (Cos(bjAngle - biAngle))) * 3959) < 2 Then
RangeSum = RangeSum + Worksheets("infotest").Range("F" & i).Value
End If
i = i + 1
Loop
Worksheets("infotest").Range("h" & j).Select
Print RangeSum
RangeSum = 0
i = 2
j = j + 1
Loop


End Sub

Thanks so much for the help so far and cleaning up my messy code, too!!

[mikerickson]

This
[VBA]Worksheets("infotest").Range("h" & j).Select
Print RangeSum[/VBA]should be replace with
[vba]Worksheets("infotest").Range("h" & j).Value = RangeSum[/vba]

The built in Help system is great for finding about the WorksheetFunction collection, the Print command and other Excel issues.

[macropod]

Hi keizai,

Assuming your own location's lat/lon are in A1 & B1, and all the other location lat/lon coordiantes are in columns A & B also, you could use:
[vba]Sub Compet()
Dim Lat1 As Single, Lat2 As Single, Long1 As Single, Long2 As Single
Dim Radians As Single, RadiusEarth As Single, i As Long, Distance As Single
RadiusEarth = 3956.56
Radians = 180 / WorksheetFunction.PI()
With ActiveSheet
Lat1 = .Range("A1").Value / Radians
Long1 = .Range("B1").Value / Radians
For i = 2 To .Cells.SpecialCells(xlCellTypeLastCell).Row
Lat2 = .Range("A" & i).Value / Radians
Long2 = .Range("B" & i).Value / Radians
Distance = _
WorksheetFunction.Acos(Sin(Lat1) * _
Sin(Lat2) + Cos(Lat1) * Cos(Lat2) * _
Cos((Long1 - Long2))) * RadiusEarth
If Distance < 2 Then .Range("H" & i).Value = Distance
Next i
End With
End Sub[/vba]
PS: When posting code, please use the VBA tag on the posting toolbar.

[Keizai]

well, the code now works to perform the task I sought out to do, which is fantastic - it will provide a very useful field in my statistical model.

to Paul in the last comment field, I like your code for it's organization and neatness - very easy to read and understand, I could use it to further simplify my code and I wonder if it won't speed up my application, which is one of my last two issues with this entry. What your code does is report the distance of every point that falls within 2 miles of the first point (i actually did this to make sure my calculations were accurate, but then I erased it because it wasn't desired) what I am trying to do is calculate the number of points (column 'f' is a column of ones in this case to count business establishments)(or I may use the sum of a field (like sales totals)) for all businesses within 2 miles for every point within the data set. The code I came up with, due to this forum, does this successfully, only it took four hours to run the program for 7700 observations, and I have to perform this operation on 9 separate datasets. I may try to further tighten the code like Paul's, if it may reduce computing time, or does anybody have other suggestions to further reduce processing time?

Also, I received a "Run-time error '1004': Unable to get the Acos property of the WorksheetFunction class". I resolved this by including 'On Error Resume Next' to prevent the process from stopping. this seemed to work and all the fields were filled in, but I am wondering if this may cause some problems in the data (it doesn't appear so) - or what is being bypassed exactly?

anyway, those are my last two concerns - 1) execution speed and 2) the nature of the error I am bypassing and potential related data problems.

here is the code I last used:

Sub Compet()

Dim i As Integer
Dim j As Integer
Dim RangeSum As Long
Dim aiAngle As Double
Dim ajAngle As Double
Dim biAngle As Double
Dim bjAngle As Double
Dim DistVal As Double

RangeSum = 0
i = 2
j = 2
DistVal = 0

Worksheets("infotest").Select
On Error Resume Next

Do Until j > 7678

Do Until i > 7678
aiAngle = 3.14159 * Range("A" & i).Value / 180
ajAngle = 3.14159 * Range("A" & j).Value / 180
biAngle = 3.14159 * Range("B" & i).Value / 180
bjAngle = 3.14159 * Range("B" & j).Value / 180
If (WorksheetFunction.Acos(Sin(ajAngle) * Sin(aiAngle) _
+ Cos(ajAngle) * Cos(aiAngle) _
* Cos(bjAngle - biAngle)) * 3959) < 2 Then
RangeSum = RangeSum + Worksheets("infotest").Range("F" & i).Value
End If
i = i + 1
Loop
Worksheets("infotest").Range("h" & j).Value = RangeSum
RangeSum = 0
i = 2
j = j + 1
Loop


End Sub

------

I really appreciate all who contributed to my coding issues - I am so excited this actually worked!!

-Eric

[macropod]

Hi Eric,

So you want to calculate the distance between each point in the dataset and every other point?! You would need a 7678 row * 7678 column matrix to store all those values! Done correctly, of course, you only need to compute the distance between locations A & B once, since the A:B distance will be the same as the B:A distance.

For such a scenario, you'll probably find the code executes much faster if you first load all the coordinates into one two-dimension array and output the results to another 7678 row * 7678 column array. Only once you're done calculating would you write all the results back to the workbook - in one go.

If you don't want to go down that path, I'd suggest setting:
Application.ScreenUpdating = False
and
Application.Calculation = xlManual
for the processing duration.

[macropod]

Duplicate