View Full Version : Extract records based on criteria
goldenvision 04-12-2005, 05:26 AM Background:
I have 26 tables relating to different areas of the country. Each table contains various name and address information, each record on the table also has a COLLID (eg 123A321). The COLLID is issued to anywhere between 5 and 200 records.
The problem:
I need to produce a separate table/excel tab for each COLLID with the related records. At the moment the only way I can think to do it is to import the file into excel, run a subtotal at each change in COLLID and cut and paste the records into sheet tabs. As there are around 3,400 COLLID's this will take a long time to do. IS anyone aware of a programmatic way of doing this.
Thanks
Brianwarnock 04-12-2005, 05:37 AM So you want 3,400 tables each consisting of between 5 and 200 records?
Or have I misuunderstood this?
Brian
goldenvision 04-12-2005, 05:39 AM no misunderstanding. that is exactly what i am after
Brianwarnock 04-13-2005, 05:13 AM Not much good at VBA but as nobody else has replied and I had a bit of time on my hands I had a go at an idea I had.
1 create a single table
2 create a query to sort on collid
3 create code to read query result and at each change of collid create a table to which you will add the records.
OK my sample is small and has no error checking, but I offer it as a pointer
please note that after today I'm not in till Monday :D but doubt if i can add to this but feel free to post
Brian
goldenvision 04-13-2005, 05:25 AM I'm not to hot on VBA myself but that seems to do the trick. I'm going to import my original table and see what happens. I'll keep you posted.
Thanks
goldenvision 04-13-2005, 05:35 AM I'm having a little bit of difficulty trying to substitute the relevant entries in the VBA for the imported live table.
Brianwarnock 04-13-2005, 05:42 AM The table is not directly referenced, you will need to sort the table into ascending oreder on collid and it is that query which is referenced in my case query1 in the code
Set master = dbs.OpenRecordset("query1")
Do not rely on the fact that your view of the table shows the records in ascending order the actula rows may not be.
Brian
goldenvision 04-13-2005, 06:51 AM I have hacked away at this VBA in my non understanding way and I think :confused: I may be getting there but noow I have hit a brick wall.
Any pointers would be extremely appreciated
Option Compare Database
Private Sub Command1_Click()
Dim dbs As DAO.Database
Dim master As DAO.Recordset
Dim newtbl As DAO.Recordset
' fldcollid was defined as a public variable in a module
Set dbs = CurrentDb()
Set master = dbs.OpenRecordset("query1")
If Not master.EOF Then
master.MoveFirst
createtbldef:
fldname = master("NAME")
Call create_Click
Set newtbl = dbs.OpenRecordset("name" & [fldname])
Do Until master.EOF
If master("name") <> fldcollid Then
newtbl.Close
GoTo createtbldef
End If
newtbl.AddNew
newtbl("ID") = master("ID")
newtbl("TITLE") = master("TITLE")
newtbl("GIVEN_NAME") = master("GIVEN_NAME")
newtbl("INITIALS") = master("INITIALS")
newtbl("FAMILY_NAME") = master("FAMILY_NAME")
newtbl("PRE_ADDRESS_LINE_1") = master("PRE_ADDRESS_LINE_1")
newtbl("BUILDING_NUMBER") = master("BUILDING_NUMBER")
newtbl("STREET_NAME") = master("STREET_NAME")
newtbl("PRE_POST_TOWN") = master("PRE_POST_TOWN")
newtbl("POST_TOWN") = master("POST_TOWN")
newtbl("COUNTY") = master("COUNTY")
newtbl("POSTCODE") = master("POSTCODE")
newtbl("STATUS") = master("STATUS")
newtbl("CONC_ID") = master("CONC_ID")
newtbl("NAME") = master("NAME")
newtbl("POR_TYPE") = master("POR_TYPE")
newtbl("COUNTY_NUMBER") = master("COUNTY_NUMBER")
newtbl("MAIN_COLLECTOR_ID") = master("MAIN_COLLECTOR_ID")
newtbl("COLLECTOR_NUMBER") = master("COLLECTOR_NUMBER")
newtbl("POOLSCARD_NUMBER") = master("POOLSCARD_NUMBER")
newtbl("MAX(GCMP_ID)") = master("MAX(GCMP_ID)")
newtbl("MAX(H_COMPETITION_NUMBER)") = master("MAX(H_COMPETITION_NUMBER)")
newtbl.Update
master.MoveNext
Loop
End If
master.Close
newtbl.Close
End Sub
Private Sub create_Click()
Dim dbscreatetabledef As Database
Dim tdfNew As TableDef
Set dbscreatetabledef = CurrentDb()
' Create a new TableDef object.
Set tdfNew = dbscreatetabledef.createtabledef("Collid" & [fldcollid])
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' database.
.Fields.Append .CreateField("collid", dbText, 20)
.Fields.Append .CreateField("flda", dbText, 20)
.Fields.Append .CreateField("fldb", dbDate)
' Append the new TableDef object to the createtabledef
' database.
dbscreatetabledef.TableDefs.Append tdfNew
End With
dbscreatetabledef.Close
End Sub
Brianwarnock 04-13-2005, 06:55 AM Tedious I know but this code needs changing to your fields also.
.Fields.Append .CreateField("collid", dbText, 20)
.Fields.Append .CreateField("flda", dbText, 20)
.Fields.Append .CreateField("fldb", dbDate)
Brian
goldenvision 04-13-2005, 07:27 AM Brian,
Thanks for the pointer. I have had limited success with my version of the VBA. It is managing to create a new table with all of the correct fields. However it isn't looping and it isn't populating the fields.
Option Compare Database
Private Sub Command1_Click()
Dim dbs As DAO.Database
Dim master As DAO.Recordset
Dim newtbl As DAO.Recordset
' fldcollid was defined as a public variable in a module
Set dbs = CurrentDb()
Set master = dbs.OpenRecordset("query1")
If Not master.EOF Then
master.MoveFirst
createtbldef:
fldname = master("NAME")
Call create_Click
Set newtbl = dbs.OpenRecordset("Edinburgh - " & [fldname])
Do Until master.EOF
If master("NAME") <> fldname Then
newtbl.Close
GoTo createtbldef
End If
newtbl.AddNew
newtbl("ID") = master("ID")
newtbl("TITLE") = master("TITLE")
newtbl("GIVEN_NAME") = master("GIVEN_NAME")
newtbl("INITIALS") = master("INITIALS")
newtbl("FAMILY_NAME") = master("FAMILY_NAME")
newtbl("PRE_ADDRESS_LINE_1") = master("PRE_ADDRESS_LINE_1")
newtbl("BUILDING_NUMBER") = master("BUILDING_NUMBER")
newtbl("STREET_NAME") = master("STREET_NAME")
newtbl("PRE_POST_TOWN") = master("PRE_POST_TOWN")
newtbl("POST_TOWN") = master("POST_TOWN")
newtbl("COUNTY") = master("COUNTY")
newtbl("POSTCODE") = master("POSTCODE")
newtbl("STATUS") = master("STATUS")
newtbl("CONC_ID") = master("CONC_ID")
newtbl("NAME") = master("NAME")
newtbl("POR_TYPE") = master("POR_TYPE")
newtbl("COUNTY_NUMBER") = master("COUNTY_NUMBER")
newtbl("MAIN_COLLECTOR_ID") = master("MAIN_COLLECTOR_ID")
newtbl("COLLECTOR_NUMBER") = master("COLLECTOR_NUMBER")
newtbl("POOLSCARD_NO") = master("POOLSCARD_NO")
newtbl("MAX(GCMP_ID)") = master("MAX(GCMP_ID)")
newtbl("MAX(H_COMPETITION_NUMBER)") = master("MAX(H_COMPETITION_NUMBER)")
newtbl.Update
master.MoveNext
Loop
End If
master.Close
newtbl.Close
End Sub
Private Sub create_Click()
Dim dbscreatetabledef As Database
Dim tdfNew As TableDef
Set dbscreatetabledef = CurrentDb()
' Create a new TableDef object.
Set tdfNew = dbscreatetabledef.createtabledef("Edinburgh - " & [fldname])
With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' database.
.Fields.Append .CreateField("ID", dbText, 10)
.Fields.Append .CreateField("TITLE", dbText, 20)
.Fields.Append .CreateField("GIVEN_NAME", dbText, 50)
.Fields.Append .CreateField("INITIALS", dbText, 5)
.Fields.Append .CreateField("FAMILY_NAME", dbText, 50)
.Fields.Append .CreateField("PRE_ADDRESS_LINE_1", dbText, 100)
.Fields.Append .CreateField("BUILDING_NUMBER", dbText, 10)
.Fields.Append .CreateField("STREET_NAME", dbText, 100)
.Fields.Append .CreateField("PRE_POST_TOWN", dbText, 100)
.Fields.Append .CreateField("POST_TOWN", dbText, 100)
.Fields.Append .CreateField("COUNTY", dbText, 100)
.Fields.Append .CreateField("POSTCODE", dbText, 15)
.Fields.Append .CreateField("STATUS", dbText, 10)
.Fields.Append .CreateField("CONC_ID", dbText, 10)
.Fields.Append .CreateField("NAME", dbText, 10)
.Fields.Append .CreateField("POR_TYPE", dbText, 10)
.Fields.Append .CreateField("COUNTY_NUMBER", dbText, 10)
.Fields.Append .CreateField("MAIN_COLLECTOR_ID", dbText, 10)
.Fields.Append .CreateField("COLLECTOR_NUMBER", dbText, 10)
.Fields.Append .CreateField("POOLSCARD_NO", dbText, 20)
.Fields.Append .CreateField("MAX(GCMP_ID)", dbText, 20)
.Fields.Append .CreateField("MAX(HCOMPETITION_NUMBER)", dbText, 20)
' Append the new TableDef object to the createtabledef
' database.
dbscreatetabledef.TableDefs.Append tdfNew
End With
dbscreatetabledef.Close
End Sub
Brianwarnock 04-13-2005, 07:48 AM Hi
Cannot spot anything, but what happened to COLLID I thought that was the field name you were splitting on,still as you have replaced all my collid with NAME incuding the Public variable it should be fine,, infact it would fail to create the 1st table def.
Does your query1 produce the correct output?
Brian
goldenvision 04-13-2005, 07:52 AM The field that the table needs to be split on is the NAME field which contains the collector reference.
Query1 now references the Edinburgh table.
BTW didn't notice that your location is Liverpool. Whereabouts are you?
Brianwarnock 04-13-2005, 07:55 AM In the city centre I work 3 days a week for Age Concern as an IT jack of all trades master of none, and you.
Brian
goldenvision 04-13-2005, 07:57 AM For Littlewoods Pools on Walton Hall Avenue. Data Analyst / Database Marketng Exec / Database Designer / Cleaner / Car Park Attendant (You get the picture)
Brianwarnock 04-13-2005, 08:01 AM The question is, is it working now?
Brian
goldenvision 04-13-2005, 08:08 AM I get the following error
Run-time error 3010
Table Edinburgh - 146J002 already exists
and when I debug it highlights
dbscreatetabledef.TableDefs.Append tdfNew
Brianwarnock 04-13-2005, 08:12 AM Er yes you have to delete all the existing files , except the input of course, before you run, in my defence I did mention this on the form :)
Brian
Brianwarnock 04-13-2005, 08:20 AM My approach was to be a flexible as possible in the number of new tables created, I suppose I could try to work out how to delete all the records in existing tables rather than create new but we'll save that for the future when I’ve got more time, unless you get there 1st and tell me.
Brian
A thought will you be repeating this exercise but appending fresh data to existing or ????
goldenvision 04-13-2005, 08:22 AM Oops. My mistake, you did mention that before you are right. I've run it again and it falls down with the following error.
Run time error 3265
Item not found in this collection
and it debugs to
newtbl("POOLSCARD_NO") = master("POOLSCARD_NO")
oh no hold on I've spotted the mistake.
The field in the master table is called POOLSCARD_NUMBER. It looks as though the coding doesn't interpret what I meant but actually what I typed. Is that not something you can add to it? :D :D ;)
Seriously that is working brilliantly now. It has just produced the 111 tables for edinburgh in a flash. Just another 33,889 to go!!!
Thanks very much. Can I reference you in the completed project document?
Brianwarnock 04-13-2005, 08:28 AM Thanks very much. Can I reference you in the completed project document?
I'd be flattered but it is not nescessary the forum exists to help all without regard to anything except getting the job done
Of course Age Concern freely accepts all donations from rich companies like Littlewoods :D :D
Just joking
Best of luck with the work & we'll need it against Juve tonight
Brian
goldenvision 04-13-2005, 08:31 AM Oh dear. I'm afraid that is were we have a difference of opinion. I am hoping that it goes to extra time and the players are knackered, a couple of players are ruled out with injury for the rest of the season and we go on to cement fourth spot!!!
Brianwarnock 04-13-2005, 08:31 AM One last thing ,if it's not a one off you should change this line
' fldcollid was defined as a public variable in a module
to keep the documentaion clear
Brian
Brianwarnock 04-18-2005, 01:04 AM Our system suddenly died on Wednesday so I could not get a response back to you. I suspected that you might be an Evertonian from you nom-de plume, wasn't "golden vision" the nickname of Alex Young? or is it just a coincidence.
Anyway my money is on Bolton as they have an easy run in, but it wont help them as we are going to get the 4th Euro spot as defending champions :D
Brian
|
|