By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
424,851 Members | 1,183 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 424,851 IT Pros & Developers. It's quick & easy.

VBA Code to Loop Through Table and Count Records That Match Criteria

P: 5
Hi everyone,
I have never posted on a site like this before but am unfortunately a bit stuck on this problem... Hopefully someone much smarter than myself can help me out!

I have a table in MS Access 2013 full of latitude and longitude values. I am wanting to use a distance formula (something like one shown below) to loop through all the records in this same table and count entries that are within a user defined distance of one-another. Ideally I could run an update query at the same time to dump the values back into the table for use in visualization software. The table has approximately 200,000 entries. Can't imagine that is enough to cause a problem.

Saying that I am even an amateur in VBA would be a stretch but I can usually figure most basic problems out. This one is a bit outside of my ability level though so any help would be greatly appreciated! Thanks in advance for any help!
Expand|Select|Wrap|Line Numbers
  1. Option Compare Database
  2. Function DistanceFeet(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double)
  3.  
  4. Dim EarthRadius As Double
  5. Dim KmtoMiFactor As Double
  6. Dim lat1Rad As Double
  7. Dim lon1Rad As Double
  8. Dim lat2Rad As Double
  9. Dim lon2Rad As Double
  10. Dim AsinBase As Double
  11. Dim DerivedAsin As Double
  12.  
  13. EarthRadius = 6371
  14.  
  15. KmtoMiFactor = 0.621371
  16.  
  17. lat1Rad = (lat1 / 180) * 3.14159265359
  18. lon1Rad = (lon1 / 180) * 3.14159265359
  19. lat2Rad = (lat2 / 180) * 3.14159265359
  20. lon2Rad = (lon2 / 180) * 3.14159265359
  21.  
  22. AsinBase = Sin(Sqr(Sin((lat1Rad - lat2Rad) / 2) ^ 2 + Cos(lat1Rad) * Cos(lat2Rad) * Sin((lon1Rad - lon2Rad) / 2) ^ 2))
  23.  
  24. DerivedAsin = (AsinBase / Sqr(-AsinBase * AsinBase + 1))
  25.  
  26. DistanceFeet = Round(2 * DerivedAsin * (EarthRadius * KmtoMiFactor) * 5280, 0)
  27.  
  28. End Function
May 15 '17 #1
Share this Question
Share on Google+
14 Replies


PhilOfWalton
Expert 100+
P: 1,430
The principal is very simple, but there is a potential problem of speed.

So a few basics.
You need a table of places TblPlaces with say
PlaceID AutoNumber PK
Place Text
Lat Double
Lon Double

You need a second table TblJoinPlacePlace with
PlaceID1 Long Joint PK
PlaceID2 Long Joint PK
Distance Double

Set up a relationship with 2 copies of TblPlace and 1 copy of TblJoinPlacePlace and join PlaceID from the first TblPlace to PlaceID1 and the PlaceID from the second TblPlace to PlaceID2.

This arrangement links every place to every place.

Problem no one is that for n locations, there are n*(n-1)/2 joins required, so with 200,000 locations, there will be approximately 20,000,000,000 records. That's a lot of calculation, and I have no concept of the time to run this calculation.

Again. I'll give you the VBA basics, but if you need further help, please come back.

In code, you need to create 3 queries.
The first one which I shall call OuterQuery reads every record in the TblPaces in PlaceID Order.
The second query, InnerQuery reads every record in the TblPlaces in PlaceID Order WHERE PlaceID > PlaceID in the OuterQuery.
The third query is to create the TblJoinPlacePlace, so you add the PlaceID from the OuterQuery to PlaceID1, the PlaceID from the InnerQuery to PlaceID2, Do your calculation by calling your Function DistanceFeet(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) based on the Lat & Long from OuterQuery (Your Lat1 & Lon1) and the Lat & Long from the InnerQuery (Your Lat2 & Lon2) to get the distance.

I have no idea if your Function DistanceFeet(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) will work, but it needs changing to

Expand|Select|Wrap|Line Numbers
  1. Function DistanceFeet(lat1 As Double, lon1 As Double, lat2 As Double, lon2 As Double) As Double
  2.  
My suggestion is to try it for just 1 record in the OuterQuery to get an idea of timing. The good thing is that on each cycle of the OuterQuery, there is 1 less record to read from the InnerQuery, so it should get faster ... on the other hand, Access has to keep track of more records....

I'm interested how fast it runs

Phil
May 16 '17 #2

jforbes
Expert 100+
P: 1,107
Do you have the tables with Latitude and Longitude already defined?

If so, you should be able to create a single Query that calls your VBA function and return your results. If you were to provide your table structure, we could provide you a query.
May 16 '17 #3

P: 5
Thank you so much for the quick response! Your idea of having one query that calls the VBA function and returns the results is sort of what I was hoping to accomplish. My knowledge of VBA is just too limited to figure out the exact syntax to make it work.

I do already have a table defined. The name of the table is [AC_PROPERTY] and has approximately 50-60 columns of data in it with about 200,000 entries. For purposes of this function, the only relevant columns I believe would be the unique identifier [PROPNUM], [LATITUDE] and [LONGITUDE].

Thanks again for the continued help with this problem!
May 16 '17 #4

PhilOfWalton
Expert 100+
P: 1,430
That sounds fine. I assume your PropNum is an Autonumber which is the same as the PlaceID to which I referred. It doesn't have to an Autonumber, but it does have to be unique.

What marginally concerns me, but it is not the slightest bit relevant to this subject is your mention of 50 to 60 columns in your AC_PROPERTY Table. I strongly suspect that your data is not normalised.

Have a go at writing the code to create the Join table, and come back when you get stuck.

Phil
May 16 '17 #5

jforbes
Expert 100+
P: 1,107
I think this query will work for you. I'm assuming you have your function saved off in a code module. If it's not in a code module, it wont be visible by the Query Engine.

Hopefully it will work out of the box. It may run horribly, but then again it may be usable the way it is. If it runs too slow, then there are options, like if the data is loaded from another application, then the Query results can be inserted into a table, after every refresh of the base data and it will be accurate and fast. I guess we can worry about that later.

The Query:
Expand|Select|Wrap|Line Numbers
  1. SELECT 
  2.   AC_PROPERTY.PROPNUM
  3. , AC_PROPERTY.LATITUDE
  4. , AC_PROPERTY.LONGITUDE
  5. , AC_PROPERTY_1.PROPNUM
  6. , AC_PROPERTY_1.LATITUDE
  7. , AC_PROPERTY_1.LONGITUDE
  8. , DistanceFeet([AC_PROPERTY].[LATITUDE],[AC_PROPERTY].[LONGITUDE],[AC_PROPERTY_1].[LATITUDE],[AC_PROPERTY_1].[LONGITUDE]) AS DistanceInFeet
  9. FROM 
  10.   AC_PROPERTY
  11. , AC_PROPERTY AS AC_PROPERTY_1
May 16 '17 #6

P: 5
You both are awesome. Thank you so much for the quick help. Let me play around with this for a few and see if I can't get it to work based on both of your input. Thanks again and I will post back on here when I can tell if it is working or not.
May 16 '17 #7

P: 5
I have been working on this a bit this morning and think that for the most part this appears to work. Ended up having to run three separate queries to get the answer I was looking for but as a whole, it doesn't take as long to run as I feared it might.

However, on the second and third query I keep getting a "Data type mismatch in criteria expression" error. Any idea what might be causing this? Queries are as follows:

Query 1:
Expand|Select|Wrap|Line Numbers
  1. SELECT AC_PROPERTY.PROPNUM, AC_PROPERTY.BH_LATITUDE, AC_PROPERTY.BH_LONGITUDE, AC_PROPERTY_1.PROPNUM, AC_PROPERTY_1.BH_LATITUDE, AC_PROPERTY_1.BH_LONGITUDE, DistanceFeet([AC_PROPERTY].[BH_LATITUDE],[AC_PROPERTY].[BH_LONGITUDE],[AC_PROPERTY_1].[BH_LATITUDE],[AC_PROPERTY_1].[BH_LONGITUDE]) AS DistanceInFeet
  2. FROM AC_PROPERTY, AC_PROPERTY AS AC_PROPERTY_1;
Query 2:
Expand|Select|Wrap|Line Numbers
  1. SELECT AC_PROPERTY.PROPNUM, AC_PROPERTY.DRILL_TYPE, AC_PROPERTY.RESERVOIR, [Q - Distance Between Wells - 1].DistanceInFeet
  2. FROM [Q - Distance Between Wells - 1] INNER JOIN AC_PROPERTY ON [Q - Distance Between Wells - 1].AC_PROPERTY.PROPNUM = AC_PROPERTY.PROPNUM
  3. WHERE (((AC_PROPERTY.DRILL_TYPE)="H") AND ((AC_PROPERTY.RESERVOIR) Like "*eagle*") AND (([Q - Distance Between Wells - 1].DistanceInFeet) Between 0.01 And 5280));
Query 3:
Expand|Select|Wrap|Line Numbers
  1. SELECT AC_PROPERTY.PROPNUM, AC_PROPERTY.DRILL_TYPE, AC_PROPERTY.LEASE, AC_PROPERTY.WELL_ID, Count([Q - Distance Between Wells - 2 (Sel zone and distance)].PROPNUM) AS CountOfPROPNUM
  2. FROM AC_PROPERTY INNER JOIN [Q - Distance Between Wells - 2 (Sel zone and distance)] ON AC_PROPERTY.PROPNUM = [Q - Distance Between Wells - 2 (Sel zone and distance)].PROPNUM
  3. GROUP BY AC_PROPERTY.PROPNUM, AC_PROPERTY.DRILL_TYPE, AC_PROPERTY.LEASE, AC_PROPERTY.WELL_ID;
May 16 '17 #8

PhilOfWalton
Expert 100+
P: 1,430
I was bored, and realising I had a Db with 249 records including Lat & Long, It took only an hour to create a database.

The advantage of creating the join table (30878 records took 3 seconds) is that it the basis for numerous queries like show me all the places within 5280 feet of Wells.

If you're are interested, I could send it to you, but would have to "butcher" some of the information.

Phil
May 16 '17 #9

P: 5
If you wouldn't mind that would be great! Like I said, I mostly got this to work but keep getting that error for some reason. Would definitely be helpful to see how you made it work if it is not too much trouble.

Thanks!
May 16 '17 #10

PhilOfWalton
Expert 100+
P: 1,430
OK, here is the database with a "butchered" address table.
It's a bit Mickey Mouse, but what do you expect in an hour?
Notice the normalisation of the tables. As I said I was concerned when you mentioned 50+ columns.

There currently is no data in the TblJoinAddressAddress table, you need to open Form1 to populate it, or clear it.

Query 1 is a sample query.

Try it on your database, and if it takes too long to populate, I have ideas that may speed it up, but it could give erroneous results.

Incidentally, not knowing where your locations are situated, I have some really, really slow VBA that gets the distances between places by road, rather than great circle distances.

Note slight change to the first & last lines of your DistanceFeet Function

Phil
May 16 '17 #11

NeoPa
Expert Mod 15k+
P: 31,308
This may sound like an obvious question, but why is no-one discussing DCount()? I'm assuming the title accurately reflects the basic requirement here.

There are always many ways to skin cats (A fairly unpleasant metaphor - I'm sorry for that), but a DCount() using a query returning the distances and criteria that specifies which are to be included seems the most direct route.
May 17 '17 #12

PhilOfWalton
Expert 100+
P: 1,430
I take your point, but the Query1 in the example I posted is a dummy query. It could equally well have been

Expand|Select|Wrap|Line Numbers
  1. SELECT Count(Address.Address1) AS CountOfAddress1, Towns.Town
  2. FROM (Towns INNER JOIN Address ON Towns.TownID = Address.TownID) INNER JOIN ((TblJoinAddressAddress INNER JOIN Address AS Address_1 ON TblJoinAddressAddress.AddressID2 = Address_1.AddressID) INNER JOIN Towns AS Towns_1 ON Address_1.TownID = Towns_1.TownID) ON Address.AddressID = TblJoinAddressAddress.AddressID1
  3. WHERE (((Towns.Town) Like "frinton*") AND ((TblJoinAddressAddress.Distance)<6000))
  4. GROUP BY Towns.Town;
  5.  
to give a count.

My point is that having created the join table, with all the distances in it, it is very simple to create queries to provide whatever information is required.

Phil
May 17 '17 #13

NeoPa
Expert Mod 15k+
P: 31,308
Hi Phil.

Let me stress that wasn't intended to sound critical. I'm sure both you and JForbes would use it where appropriate and understand that the fundamental querying underneath is the critical part. SMcClaren, a self-confessed newbie, may not have appreciated all the subtleties though, so I thought I'd just make sure this was one element they could be clear on.

It's easy to forget that we can rabbit on a hundred to the dozen making good sense all the way while someone else can get lost at the first part and wonder what's going on. Anyway, good work all rounf :-)

@SMcClaren.
I will probably have updated your posts to include the [CODE] tags that are mandatory when posting code. Please try to add them yourself when posting going forward.
May 17 '17 #14

NeoPa
Expert Mod 15k+
P: 31,308
Having updated your posts now I noticed a very import line of code that's missing. Please see Require Variable Declaration.
May 17 '17 #15

Post your reply

Sign in to post your reply or Sign up for a free account.