Thanks John
have a safe trip
pete
Hi John,
I've had a brief chance to look at your zipfile. I like the fish and hook :-)
at First glance it does exactly whats needed. Although the member name fields aren't present in my example, the records were in alphabetical order before I deleted the fields and they've stayed put. so the keys have been assigned 1 upwards in A-Z order. Perfect.
I see that you added bulk return too. Thank you for that. it may prove useful but we have yet to enter that territory. the first keys won't be returned until this time next year.
i'll spend some time reading through the code so that I understand it, but I think you've nailed it.
regards
Pete
Hi Pete!
Note that I have removed the fields from the table New_key_register and I use the qryKeys as recordsource for the left dataset of the form. If you want to keep those fields, import again the original table and run the query below, after the bulk issue, to update them:
If you want the bulk issue to be applied with the lists of the keys and the members sorted in ascending, the both statements in code need an ORDER BY clause, as seems below:Code:UPDATE No_key INNER JOIN New_key_register AS Reg ON No_key.NEWKEY = Reg.Keyno SET Reg.Kpermno = [APERMNO], Reg.Kseason = [SEASON], Reg.used = -1 WHERE nz([Reg].[Kpermno],0)=0;
(of course, the field "initial" must exists in table No_Key)Code:'SQL for the members of the given year. strSQLIssued = "SELECT APERMNO, SEASON, NEWKEY FROM No_key " _ & "WHERE SEASON=" & intYear 'SQL for the available keys for the given year. strSQLReg = "SELECT Keyno " _ & "FROM New_key_register AS Reg " _ & "LEFT JOIN (" & strSQLIssued & ") AS Iss " _ & "ON Reg.Keyno = Iss.NEWKEY " _ & "WHERE Iss.NEWKEY Is Null " _ & "ORDER BY Reg.Keyno;" 'SQL for only members w/o keys for the given year. strSQLIssued = strSQLIssued & " AND NEWKEY is null ORDER BY No_key.Initial;"
Also, I have an idea...
If the Keyno have 500 records with nums from 1 to 500, the query below returns a different set of 250 nums for each current year in turn:
For example, for 2021, returns 250 records from 251 to 500. I think that you will find it useful in the future.Code:SELECT New_key_register.Keyno FROM New_key_register WHERE Int(([Keyno]-1)/250)=(Year(Date()) Mod 2);
Cheers,
John
Many thanks JohnHi Pete!
Note that I have removed the fields from the table New_key_register and I use the qryKeys as recordsource for the left dataset of the form. If you want to keep those fields, import again the original table and run the query below, after the bulk issue, to update them:
If you want the bulk issue to be applied with the lists of the keys and the members sorted in ascending, the both statements in code need an ORDER BY clause, as seems below:Code:UPDATE No_key INNER JOIN New_key_register AS Reg ON No_key.NEWKEY = Reg.Keyno SET Reg.Kpermno = [APERMNO], Reg.Kseason = [SEASON], Reg.used = -1 WHERE nz([Reg].[Kpermno],0)=0;
(of course, the field "initial" must exists in table No_Key)Code:'SQL for the members of the given year. strSQLIssued = "SELECT APERMNO, SEASON, NEWKEY FROM No_key " _ & "WHERE SEASON=" & intYear 'SQL for the available keys for the given year. strSQLReg = "SELECT Keyno " _ & "FROM New_key_register AS Reg " _ & "LEFT JOIN (" & strSQLIssued & ") AS Iss " _ & "ON Reg.Keyno = Iss.NEWKEY " _ & "WHERE Iss.NEWKEY Is Null " _ & "ORDER BY Reg.Keyno;" 'SQL for only members w/o keys for the given year. strSQLIssued = strSQLIssued & " AND NEWKEY is null ORDER BY No_key.Initial;"
Also, I have an idea...
If the Keyno have 500 records with nums from 1 to 500, the query below returns a different set of 250 nums for each current year in turn:
For example, for 2021, returns 250 records from 251 to 500. I think that you will find it useful in the future.Code:SELECT New_key_register.Keyno FROM New_key_register WHERE Int(([Keyno]-1)/250)=(Year(Date()) Mod 2);
Cheers,
John
I hope to have a proper look over the weekend now that I have some time
unless my wife has other plans for my spare time...
much appreciated
Thank you
Pete
You are welcome Pete!
Take your time and enjoy.
I know very well that, when a wife has a plan that include you, it's impossible to avoid it.
Have a nice weekend,
John
Hi John,
weekend didn’t go as planned. Mother-in-law got whipped into hospital Saturday morning. Nothing serious just major discomfort. Was back home late afternoon. Late Sunday night, she felt poorly so called a doctor out, who arrived at 3.30am by which time she felt a bit better!
spent yesterday recouping some of the missing night’s sleep. Should have made up the deficit by the morning.
The in-laws just spent the day sleeping and we’re fine after that!!!
i had brief look at your last post and I think I understand. If I bring in my original key register that I posted and run that first piece of new code after bulk issue, that will put all in place as I wanted.
I’ll have a proper look once sleep deprivation has receded and my outstanding list of weekend tasks get done :-)
regards
Pete
Hi John,
I've managed to stay awake long enough tonight to test out the first piece of new code and it does exactly what you promised. Many thanks
I'll weave the whole thing into my test DB and see what happens.
Your DB seems to quite happily work with the both tables data in their existing sort order (which the correct sort). Am I right in thinking that your code will not change that. It certainly looks that way. It may be that your second new piece of code might not be needed.
Many thanks
Pete
Hi John
Now that I'm wide awake (ish), I've integrated your code into my DB. had afe teething troubles but sorted now.
Needs some more testing but I think that I've established that I dont need to separate members with no keys before bulk issuing.
It appears to fill in in any gaps where no key has been issued. In essence, it works way better than I'd hoped!
many thanks indeed
Regards
Pete
Hi John,
i’ve integrated your work into my DB and it works better than anticipated! Keys can also be added or returned singly which is really useful.
there’s one minor error which is no great problem; the bulk return removes all but the first two keys.
for the life of me I can’t spot why.
any idea?
kind regards
Pete
Back in March last year, Accestos kindly wrote a routine which bulk issued key numbers for each member of of my Charity's fishing lakes
The code worked flawlessly last year.
Sadly Accestos seems to have ceased posting since early December. I hope he's alright though he hasn't responded to a PM.
I wonder if any one can get me out of a hole.
What I didn't foresee was that code needed to be able to switch to second set of keys. At present it will simply issue the lowest number range of keys because there are some spare ones.
There are two ranges of numbers; 1-499 and 500-699. the first range has only 250 numbers leaving room for extra if necessary. This year I need to issue the 500 series, next year the 1 series and back to 500 series again.
I have pasted below John's code but it can be found in the keys.zip attachment in post #12 above.
The code works from the BOF to EOF and sadly I have no idea to rewrite this. It's well beyond me.
I'd appreciated any help. I've highlighted where I think the code kicks in, in red
Many thanks
Pete
Function IssuedKeys(Optional intYear As Integer) As Long
Dim rsNew As DAO.Recordset
Dim rsIssued As DAO.Recordset
Dim db As DAO.Database
Dim i As Integer
Dim strSQLReg As String
Dim strSQLIssued As String
On Error GoTo ErrH
If intYear = 0 Then
'No specific input year.
'Get current year.
intYear = Year(Date)
End If
'SQL for the members of the given year.
strSQLIssued = "SELECT APERMNO, SEASON, NEWKEY FROM No_key " _
& "WHERE SEASON=" & intYear
'SQL for the available keys for the given year.
strSQLReg = "SELECT Keyno " _
& "FROM New_key_register AS Reg " _
& "LEFT JOIN (" & strSQLIssued & ") AS Iss " _
& "ON Reg.Keyno = Iss.NEWKEY " _
& "WHERE Iss.NEWKEY Is Null;"
'SQL for only members w/o keys for the given year.
strSQLIssued = strSQLIssued & " AND NEWKEY is null;"
Set db = CurrentDb
Set rsIssued = db.OpenRecordset(strSQLIssued, dbOpenDynaset)
With rsIssued
If Not (.BOF And .EOF) Then
'Get the available keys from New_key_register.
Set rsNew = db.OpenRecordset(strSQLReg, dbOpenDynaset)
If Not (rsNew.BOF And rsNew.EOF) Then
While (Not .EOF) And (Not rsNew.EOF)
.Edit
'Add this key to this member.
!NEWKEY = rsNew!Keyno
.Update
rsNew.MoveNext
.MoveNext
i = i + 1
Wend
End If
End If
End With
ExitHere:
On Error Resume Next
rsNew.Close
Set rsNew = Nothing
rsIssued.Close
Set rsIssued = Nothing
Set db = Nothing
IssuedKeys = i
On Error GoTo 0
Exit Function
ErrH:
MsgBox "Error: " & Err & vbCrLf & Err.Description, vbExclamation, "Bulk Issue"
Resume ExitHere
End Function
If I understand correctly, you want even numbered years to use key numbers from 500 - 699 and odd numbered years key numbers 1-499?
If this is correct,
1) Add a new field in table "New_key_register" named "KeySeries" of type "Number - BYTE".
2) For all records where "Keyno" is between 1 and 499, "KeySeries" is equal to 1.
3) For all records where "Keyno" is between 500 and 699, "KeySeries" is equal to 0.
4) Then in "Function IssuedKeys(Optional intYear As Integer) As Long", change
toCode:'SQL for the available keys for the given year. strSQLReg = "SELECT Keyno " _ & "FROM New_key_register AS Reg " _ & "LEFT JOIN (" & strSQLIssued & ") AS Iss " _ & "ON Reg.Keyno = Iss.NEWKEY " _ & "WHERE Iss.NEWKEY Is Null;" 'SQL for only members w/o keys for the given year. strSQLIssued = strSQLIssued & " AND NEWKEY is null;"
Code:'SQL for the available keys for the given year. strSQLReg = "SELECT Reg.Keyno" strSQLReg = strSQLReg & " FROM New_key_register AS Reg" strSQLReg = strSQLReg & " LEFT JOIN (SELECT APERMNO, SEASON, NEWKEY FROM No_key WHERE SEASON=2022) AS Iss" strSQLReg = strSQLReg & " ON Reg.Keyno = Iss.NEWKEY" strSQLReg = strSQLReg & " WHERE (Reg.KeySeries)= " & ([Forms]![frmKeys].[cboYear] Mod 2) & " AND (Iss.NEWKEY Is Null);"
------------------------------------------------------------------------------------------------------------
Just curious, is there something special about Key numbers 1 & 2?
In the code, keys 1 & 2 can never be returned:
Code:Private Sub cmdReturn_Click() ' Bulk Return With CurrentDb .Execute "UPDATE No_key SET NEWKEY = Null " _ & "WHERE (NEWKEY>2) AND (SEASON=" & Nz(Me!cboYear, 0) & ");" If .RecordsAffected Then MsgBox .RecordsAffected & " keys returned.", vbInformation, Me.Caption & " " & cboYear Me.Refresh Else Beep End If End With End Sub
Thank you Steve. Much appreciated. I’ll have a play around with the coding later today.
never realised the odd and even years but yes that’s quite true. The actual keys are an expensive piece of kit but can be continually re-cut for years to come so the number ranges won’t change.
the returns code had me fooled for a while. There’s no significance in keys 1 & 2. Must have been a throwback from Steve’s original testing.
Bulk return is OK but I doubt we we will get all keys returned. A few are bound to go missing.I have some separate code in place for complete ranges and individual keys which is more likely to be used.
many thanks and best wishes
Pete
Thank you Steve. Again, very much appreciated.
I’ve inserted the code and it works fine
just got user testing to get through and we should be good to go!
many thanks and best wishes
Pete
Happy to be able to help.
BTW,
If you ever want to return keys 1 & 2, all you need to do is change NEWKEY > 2 to NEWKEY > 0 (zero).Code:Private Sub cmdReturn_Click() ' Bulk Return With CurrentDb .Execute "UPDATE No_key SET NEWKEY = Null " _ & "WHERE (NEWKEY > 2) AND (SEASON=" & Nz(Me!cboYear, 0) & ");" If .RecordsAffected Then MsgBox .RecordsAffected & " keys returned.", vbInformation, Me.Caption & " " & cboYear Me.Refresh Else Beep End If End With End Sub
Good luck with your project.....
Hi Guys
I have a bit of bother with an SQL module.
The work that you contributed to a couple of years ago and for which I'm exceedingly grateful, has been great, however I've hit a snag.
The New_key_register has a [used] field which is either true or false. Up to now all the keys have only had one use and all were available. This year, the first set have been re-cut and some keys are missing- not returned.
The key register records who has those missing keys. Keeping them on the register means we can can cut replacements if needed.
My SQL ability is less than useless!
If I read the final part of the module correctly, the routine takes no account of used keys and thus two things happen; If run once, Keys we dont have are being issued and If run more than once, the keys that we do have are being issued twice.
I think that routine simply runs BOF to EOF. I need to exclude the issuing of any key where The [used] field in the New_key_register table is False
I've highlighted what I believe is the appropriate routine in red
The remainder of the module seems to work fine.
Would appreciate any assistance
Function IssuedKeys(Optional intYear As Integer) As Long
Dim rsNew As DAO.Recordset
Dim rsIssued As DAO.Recordset
Dim db As DAO.Database
Dim i As Integer
Dim strSQLReg As String
Dim strSQLIssued As String
On Error GoTo ErrH
If intYear = 0 Then
'No specific input year.
'Get current year.
intYear = Year(Date)
' intYear = [Forms]![frmKeys].[cboYear]
End If
'SQL for the members of the given year.
strSQLIssued = "SELECT APERMNO, SEASON, NEWKEY FROM No_key " _
& "WHERE SEASON=" & intYear
'SQL for the available keys for the given year.
strSQLReg = "SELECT Reg.Keyno"
strSQLReg = strSQLReg & " FROM New_key_register AS Reg"
strSQLReg = strSQLReg & " LEFT JOIN (SELECT APERMNO, SEASON, NEWKEY FROM No_key WHERE SEASON=2022) AS Iss"
strSQLReg = strSQLReg & " ON Reg.Keyno = Iss.NEWKEY"
strSQLReg = strSQLReg & " WHERE (Reg.KeySeries)= " & ([Forms]![frmKeys].[cboYear] Mod 2) & " AND (Iss.NEWKEY Is Null);"
'SQL for only members w/o keys for the given year.
strSQLIssued = strSQLIssued & " AND NEWKEY is null;"
Set db = CurrentDb
Set rsIssued = db.OpenRecordset(strSQLIssued, dbOpenDynaset)
With rsIssued
If Not (.BOF And .EOF) Then
'Get the available keys from New_key_register.
Set rsNew = db.OpenRecordset(strSQLReg, dbOpenDynaset)
If Not (rsNew.BOF And rsNew.EOF) Then
While (Not .EOF) And (Not rsNew.EOF)
.Edit
'Add this key to this member.
!NEWKEY = rsNew!Keyno
.Update
rsNew.MoveNext
.MoveNext
i = i + 1
Wend
End If
End If
End With
ExitHere:
On Error Resume Next
rsNew.Close
Set rsNew = Nothing
rsIssued.Close
Set rsIssued = Nothing
Set db = Nothing
IssuedKeys = i
On Error GoTo 0
Exit Function
ErrH:
MsgBox "Error: " & Err & vbCrLf & Err.Description, vbExclamation, "Bulk Issue"
Resume ExitHere
End Function