Change Sequence of Remaining Records After Updating Number of Another

[angelaing]

I have a continuous form with list of Projects ordered by Business Unit Rank. The users want to be able to update the Business Unit Rank to any number and have the remaining numbers resequence. So if the user updates Business Unit Rank from 6 to 3, the current number 3 should change to 4, 4-5, 5-6, etc. without 1 and 2 being changed. If the user changes 6 to 1 for example then the other 1 should change to 2, 2-3, etc. This is the code I have now. Someone was helping me with this.

Private Sub ReRank()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim n As Integer
 
    Me.Dirty = False
 
    strSQL = "SELECT BusUnitID, GrpUnitRank, StatusID, ProjID FROM t_Projects WHERE BusUnitID = " & cmbBusUnit & " and StatusID = " & Me.cmbStatus & " ORDER BY GrpUnitRank"
    Set rst = CurrentDb.OpenRecordset(strSQL)
    With rst
        .MoveLast
        n = 1
        .MoveFirst
        Do While Not .EOF
            .Edit
            .Fields("grpUnitRank") = n + 1
            .Update
            Debug.Print
            n = n + 1
            .MoveNext
        Loop
    End With
    Set rst = Nothing
 
    Me.Requery
End Sub

[NeoPa]

Your post implies the code doesn't work as expected but you don't say what goes wrong where. This is useful information when posting a question.

[angelaing]

I attached screenshots to provide an example but I changed a record ranked 5 to 1 and it moved it to 2 instead. Also here is the code. I changed one line from the previous code. Instead of n+1 i changed it to just n.

Private Sub ReRank()
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim n As Integer
 
    Me.Dirty = False
 
    strSQL = "SELECT BusUnitID, GrpUnitRank, StatusID, ProjID FROM t_Projects WHERE BusUnitID = " & cmbBusUnit & " and StatusID = " & Me.cmbStatus & " ORDER BY GrpUnitRank"
     Set rst = CurrentDb.OpenRecordset(strSQL)
        With rst
        .MoveLast
        n = 1
        .MoveFirst
        Do While Not .EOF
            .Edit
            .Fields("grpUnitRank") = n
            .Update
            Debug.Print
            n = n + 1
            .MoveNext
        Loop
    End With
    Set rst = Nothing
 
    Me.Requery
 
 
End Sub

so it works sometimes but if i change the record ranked number 2 to 1 it will stay as 2 when the After Update Event fires. Well it doesn't matter if I put it in the After Update or call the proc from the Click Event of the column Header Label. Does the same thing. It seems like it might be looking at both number 1 rank'd and then alphabetizing by Project Name. Logically I need for it to change the former #1 to #2. Does that make sense?
Before.JPG

WhileChanging.JPG

AfterUpdate.JPG

[PhilOfWalton]

Angela,

Without writing the code for you, although, if you get stuck, I will try to help further.

Firstly, I am assuming that on the BeforeUpdate of the Rank you check that the value entered is > 0 and <= Maximum Rank

Secondly, for the method I am suggesting it requires that Duplicates are allowed for Rank.

What I am going to suggest is not in a logical order, but you will see why.

So after you update the Rank, create a Query that has the table in Rank Order. There should be one of the Ranks that appears twice. So what you need to do is determine which is the original Rank and which is the Rank you have just entered. So save the lower of the OldValue and new value of the Rank.

Run an update routine similar to the one that you have written, and add 1 to the existing Rank of all Ranks greater than the value you have saved.

Come back with any problems

Phil

[twinnyfo]

Since you have a continuous form, and not a datasheet, you could also add "Move Up"/"Move Down" command buttons to the detail sectoin of the form. By doing this, you only have to work with two records at a time. Assuming you allow duplicates (as Phil recommends) you find the record that has a rank of Me.grpUnitRank - 1 (or + 1, depending upon whether moving up or down), change that record's value and then assign the appropriate value to the record you want to move. Then, just requery the form.

This may be a bit more flashy and/or more involved, but it prevents the confusion that could eb caused by trying to remember which is the new value and which is the new value.

Just a thought....

[PhilOfWalton]

Please ignore my last post, it doesn't work.

Am having another look at it

Phil

[NeoPa]

Hi Angela.

I suspect you've probably noticed already that the interface you've conceived doesn't work well from a logical standpoint. If I understand correctly, once you've updated the position of a record, and before the logic's run, you have two records with the same number.

There are two ways of handling the overall logic. One is with code-type logic and is processed using VBA, and the other is using batch-type logic and is processed in a SQL UPDATE.

Now, code is fine for this job but really needs to be treated as a single transaction (See DAO Transaction Processing - What is it?), which is fine if you're comfortable handling that. It's probably better though, to handle such an update as a batch - also contained within a single transaction, but more easily. I'll look at that here for you.

Now, in order to avoid the problem where we end up with two records having the same number, and separately to store which numbers are going to need to change, we'll handle some of this logic in VBA, and more especially Event procedures. To help visualise what's going on below consider some example data where we have nine records ordered #1 to #9. We will then update #7 to read 3 instead.

Consider what we need to do here :

1. Ignore anything above #7. None of these will change during this process.
2. Ignore anything below #3. None of these will change during this process.
3. Update #7 to #3.
4. Update all others between #3 & #6 to increment by one.

Considering the above steps though, what happens if, before we apply this logic #7 has already been updated to 3? We would have no #7 and two #3s. This would make it impossible to apply the logic reliably.

What I suggest we do at that point then, is to capture the update from 7 to 3 before the update is actually applied. At that point we note the new number as well as the old (NB. We must handle both upward and downward movements.) in order to build the SQL correctly. Assuming the control is called [txtRank] then the Event Procedure we're talking about will be txtRank_BeforeUpdate().

NB. While we're still in the Event Procedure the Field value will be locked for the current record. Therefore we need to execute the SQL to update the data elsewhere - after the record lock has been lost. You'll see later that we'll Cancel the update to the value in the control so we can't use the AfterUpdate() Event Procedure either. So, we'll have to use a technique whereby we use the Timer Event Procedure and simply trigger it once from our BeforeUpdate() Event Procedure.

If this all sounds complicated then it's only because it is ;-) However, I'll provide some sample code to illustrate it all that you can use and work with.

To start with we have to define a constant and some variables that will be accessible to all the code within the Form's module (At the top - outside all procedures.) :

Option Compare Database
Option Explicit
 
'%FV = From Value; %TV = To Value; %PM = +/-
'%LL = Lower limit; %UL = Upper Limit; %NL = New Line
Private Const conSQL As String = _
               "UPDATE [t_Projects]%NL" _
             & "SET [GrpUnitRank]=IIf([GrpUnitRank]=%FV,%TV,[GrpUnitRank] %PM 1)%NL" _
             & "WHERE  ([GrpUnitRank] Between %LL And %UL)"
 
Private lngFrom As Long, lngTo As Long

The SQL will need to be modified by the code before it can be used. %LL & %UL are the same as %FV & %TV but which matches which depends on the direction of movement (%PM). The variables store the value of the updated control before and after the user entered a change.

Next we have the BeforeUpdate Event Procedure :

Private Sub txtRank_BeforeUpdate(Cancel As Integer)
    'We never actually update this value from the form.
    Cancel = True
    With Me
        With .txtRank
            'Update not valid if new value either same as old OR > num recs.
            If .Value = .OldValue _
            Or .Value > DCount(Expr:="*", Domain:="[t_Projects]") Then _
                Exit Sub
            lngFrom = .OldValue
            lngTo = .Value
        End With
        'Set the Timer procedure to fire when this one completes.
        .OnTimer = "[Event Procedure]"
        .TimerInterval = 1
    End With
End Sub

When that's completed the update will have been reversed regardless, but assuming the tests have been passed it will then execute the OnTimer procedure below.
NB. At this point it's possible to make updates to all the records assuming there are no locks elsewhere.

Private Sub Form_Timer()
    Dim strSQL As String
    Dim dbVar As DAO.Database
 
    With Me
        'This is a one-off so we disable it from running again.
        .OnTimer = ""
        .TimerInterval = 0
    End With
    'Do nothing if lngFrom or lngTo are not set.
    If lngFrom = 0 _
    Or lngTo = 0 Then _
        Exit Sub
    'Replace all the place-holders from conSQL with our values.
    strSQL = Replace(conSQL, "%FV", lngFrom)
    strSQL = Replace(strSQL, "%TV", lngTo)
    strSQL = Replace(strSQL, "%PM", IIf(lngFrom > lngTo, "+", "-"))
    strSQL = Replace(strSQL, "%LL", IIf(lngFrom > lngTo, lngTo, lngFrom))
    strSQL = Replace(strSQL, "%UL", IIf(lngFrom > lngTo, lngFrom, lngTo))
    strSQL = Replace(strSQL, "%NL", vbNewLine)
    Set dbVar = CurrentDb()
    'For now we ignore errors.
    'That can be added later without need for my help.
    On Error Resume Next
    Call dbVar.Execute(Query:=strSQL, Options:=dbFailOnError)
    If Err.Number = 0 Then
        Call Me.Requery()
        lngFrom = 0
        lngTo = 0
    End If
End Sub

Using my MultiReplace() Function can certainly simplify the replacement part as all of the replacements can then be handled by a single call.

NB. This is all air-code so you may need to do some testing first. I've designed it in such a way as to make it easier to add failure handling. If the update fails then you can simply change where the Timer is reset so it's only done after success, and you can change the TimerInterval to something more meaningful than a single millisecond.

[PhilOfWalton]

Angela

I was feeling bored, and Twinnyfo's suggestion of up & down buttons is an excellent idea.

This little offering will show you the principal, the advantage is you can easily see what is happening.

You will have to alter the recordsource and the StrSQL to add BusID and Status criteria.

Phil

[angelaing]

It was making sense right up to the time I saw the code for the Timer Event. Very creative. I will give it a try and get back to you.

[angelaing]

Phil, I will look at yours also. My first reply was to NeoPa. And I haven't even mentioned that I need to do a re-ranking from a single form when users are adding new Projects. I don't even want to think about that yet but I think that one should be easier, maybe.

[NeoPa]

AngelaIng:
It was making sense right up to the time I saw the code for the Timer Event.

That's good. Let's have a closer look at that code then. To look at that code (Form_Timer()) we first need to study conSQL from the first block.

There are, within that string, some place-holders that we later update with the appropriate values. The comment explains what's what. Look at that string carefully before proceeding and possibly use the test scenario outlined earlier to anticipate what the SQL string should look like once the place-holders have all been replaced. The scenario was to update record #7 to make it #3. In that case the place-holders would be :
%FV ==> From Value = 7
%TV ==> To Value = 3
%PM ==> +/- = +
%LL ==> Lower Limit = 3
%UL ==> Upper Limit = 7
%NL ==> New Line = vbNewLine
So, the SQL string that results after all the changes are made in Form_Timer() is :

UPDATE [t_Projects]
SET [GrpUnitRank]=IIf([GrpUnitRank]=7,3,[GrpUnitRank] + 1)
WHERE  ([GrpUnitRank] Between 3 And 7)

Notice that were the change the other way around (From #3 to #7 instead of #7 to #3.) then the Upper & Lower Limits would stay the same; the From & To Values would be reversed; the +/- would be '-' instead of '+'.

Most of the code in Form_Timer() is based around updating and running that SQL. A little at the start to check that we don't proceed with nonsense data, and a little at the end to reset the variables and the Form so that the same update can't be run again and the new data is shown on the form in its new order. So, ignoring that code, we can focus on lines #14 to #25.

Lines #14 to #20 simply replace the place-holders with the appropriate values.
Lines #21 to #25 simply set up the DAO.Database object and execute the SQL previously prepared.

[angelaing]

NeoPa, I attached the code to the Events you suggested and after I type in a new number to any record on the continuous form nothing happens it sits there forever. I can't click the close button on the form or navigate up or down. I can tab to a new field in the same record but that's it.

When I finally Right Click and choose to put in Design Mode I get the message shown in the screenshots. If I comment out the On Error Resume Next in the Form_Timer Event I get Run Time Error 3021 "No Current Record."

I'm thinking I need to capture the BusUnitID value and set the form's recordset again and then requery but I am not that good at this so excuse my ignorance that may be totally wrong. Can you advise?

Private Sub Form_Timer()
    Dim strSQL As String
    Dim dbVar As DAO.Database
 
    With Me
        'This is a one-off so we disable it from running again.
        .OnTimer = ""
        .TimerInterval = 0
    End With
    'Do nothing if lngFrom or lngTo are not set.
    If lngFrom = 0 _
    Or lngTo = 0 Then _
        Exit Sub
 
    'Replace all the place-holders from conSQL with our values.
    strSQL = Replace(conSQL, "%FV", lngFrom)
    strSQL = Replace(strSQL, "%TV", lngTo)
    strSQL = Replace(strSQL, "%PM", IIf(lngFrom > lngTo, "+", "-"))
    strSQL = Replace(strSQL, "%LL", IIf(lngFrom > lngTo, lngTo, lngFrom))
    strSQL = Replace(strSQL, "%UL", IIf(lngFrom > lngTo, lngFrom, lngTo))
    strSQL = Replace(strSQL, "%NL", vbNewLine)
    Set dbVar = CurrentDb()
    'For now we ignore errors.
    'That can be added later without need for my help.
   ' On Error Resume Next
    Call dbVar.Execute(Query:=strSQL, Options:=dbFailOnError)
    If Err.Number = 0 Then
        lngFrom = 0
        lngTo = 0
        Call Me.Requery()
    End If

[PhilOfWalton]

Angela

I was still feeling bored, so have revamped the Db I sent to cover your concerns about adding & deleting projects.

I am still showing the rank, but I have a feeling that the number is pretty irrelevant. I suspect that what you really want is to show the projects in order of importance.

Phil

[twinnyfo]

@NeoPa

Brilliant idea to Cancel the Update and then use the Timer Event. Definitely a unique way of approaching things!

[NeoPa]

Thanks for the vote of confidence Twinny :-)

It actually shows you have the understanding of how complicated was the original requirement as well as the unusual nature of the solution.

I can tell you I went through a number of variations and bumped into various gotchas. The eventual solution was a result of trying to untangle the logic and make a path through the limitations such as having multiple copies of the same rank and being unable to run an UPDATE query while the record was still locked.

I was very happy to find a workable solution in the end so I feel it was worth the time and effort. A very interesting exercise.

@Angela.
I will respond to your post shortly, assuming I remain uninterrupted by work requirements for a while. All being well I'll have a response for you within the next couple of hours.

[angelaing]

This is a very complicated requirement and solution. I know you are putting a tremendous amount of thought into making this all work. I'm am putting a tremendous amount of time just to follow where your going with it. I think I understand the logic than I get an ahaha gotcha somewhere but that may be just me. Thanks so much

[NeoPa]

AngelaIng:
NeoPa, I attached the code to the Events you suggested and after I type in a new number to any record on the continuous form nothing happens it sits there forever. I can't click the close button on the form or navigate up or down. I can tab to a new field in the same record but that's it.

It would be interesting to see if you've set Event properties up properly to run the code, and if the code IS running whether or not it goes wrong anywhere. What are your debugging skills like (See Debugging in VBA)?

What version of Access are you running this with?
Is it possible for you to attach a ZIPped copy of this and any back-end files that may be necessary for me to try running it here. It's much easier to find problems when they're in front of you.

I believe this concept should work, but I haven't tested it for real yet.

[angelaing]

And NeoPa, this is the solution they want to use. So I'll keep trying to figure out what's going on in the meantime. I have to take off for an appointment in 30 minutes but will get back to it.

[angelaing]

I set watches and stepped through code to see the various values but I still think my debugging skills are not that good.

I have to run right now to go to an appt that's about an hour away so I won't be back until much later today but I will look at your link then and if I still can't figure it out if you don't mind I will either send you a copy of all the code. i could even send you the whole database but there are two of them. It's not a sql server back end a 2003 mdb back end and 2016 accdb front. I could import all the table objects into the 2016 front end and send it to you that way but then having them all in one might cause some behavioral changes. I don't know.

[angelaing]

or just send a copy of the code. Thanks, will catch up later

[angelaing]

I keep trying to send you a message and somethings going wrong. I will look at your instructions first. There's more to debugging than stepping through code. I glanced at your instructions on debugging and there's more for me to learn so let me work on it more when I GET Back and i will let you know

[NeoPa]

I have some changes to post.

I've created a copy for myself in 2010 and found a problem or two. You go for your appointment elsewhere and you should have some better code to play with when you get back.

[angelaing]

ok so i am a little late. I am in a hurry so I just read parts of your email but when I read the printed out version of the email I can see you asked for a copy of the code. By now I could have sent it to you. I will do both, send you a copy and try and figure it out on my own so I learn. Ok, it will be in about 6 hours and I know there's a time difference. Take care

[NeoPa]

Right. As I said earlier, I now have a proof of concept working perfectly in a very small Access 2010 ACCDB that I've attached in a ZIP file.

The main points I found that had to be addressed seem to line up nicely with your own experience and were about using Undo() to set the Control and the Form (Current record) back to before the operator even started to make changes to them. Using Cancel alone stops the change from being applied, but leaves the changed data for the operator to have another try at it. What I had to do was to clear any changes, first in the Control, and then in the Form, so that the changed record released it's lock.

Anyway, the latest code is now :

Option Compare Database
Option Explicit
 
'%FV = From Value; %TV = To Value; %PM = +/-
'%LL = Lower limit; %UL = Upper Limit; %NL = New Line
Private Const conSQL As String = _
               "UPDATE [t_Projects]%NL" _
             & "SET [GrpUnitRank]=IIf([GrpUnitRank]=%FV,%TV,[GrpUnitRank] %PM 1)%NL" _
             & "WHERE  ([GrpUnitRank] Between %LL And %UL)"
 
Private lngFrom As Long, lngTo As Long
 
Private Sub Form_Timer()
    Dim strSQL As String
    Dim dbVar As DAO.Database
 
    With Me
        'This is a one-off so we disable it from running again.
        .OnTimer = ""
        .TimerInterval = 0
    End With
    'Do nothing if lngFrom or lngTo are not set.
    If lngFrom = 0 _
    Or lngTo = 0 Then _
        Exit Sub
    'Replace all the place-holders from conSQL with our values.
    strSQL = Replace(conSQL, "%FV", lngFrom)
    strSQL = Replace(strSQL, "%TV", lngTo)
    strSQL = Replace(strSQL, "%PM", IIf(lngFrom > lngTo, "+", "-"))
    strSQL = Replace(strSQL, "%LL", IIf(lngFrom > lngTo, lngTo, lngFrom))
    strSQL = Replace(strSQL, "%UL", IIf(lngFrom > lngTo, lngFrom, lngTo))
    strSQL = Replace(strSQL, "%NL", vbNewLine)
    Set dbVar = CurrentDb()
    'For now we ignore errors.
    'That can be added later without need for my help.
    On Error Resume Next
    Call dbVar.Execute(Query:=strSQL, Options:=dbFailOnError)
    If Err.Number = 0 Then
        Call Me.Requery
        lngFrom = 0
        lngTo = 0
    End If
End Sub
 
Private Sub txtRank_BeforeUpdate(Cancel As Integer)
    'We never actually update this value from the form.
    Cancel = True
    With Me
        With .txtRank
            'Update not valid if new value either same as old OR > num recs.
            If .Value = .OldValue _
            Or .Value > DCount(Expr:="*", Domain:="[t_Projects]") Then _
                Exit Sub
            lngFrom = .OldValue
            lngTo = .Value
            'Undo pending change made to the value.
            Call .Undo
        End With
        'Although this may lose other changes to the record it's necessary
        'in order to release the lock on the current record.
        Call .Undo
        'Set the Timer procedure to fire when this one completes.
        .OnTimer = "[Event Procedure]"
        .TimerInterval = 1
    End With
End Sub

I've set up my database with the same names where necessary for the code to work so this code should work for you as-is.

The SQL created when I ran this in the scenario outlined in an earlier post was :

UPDATE [t_Projects]
SET [GrpUnitRank]=IIf([GrpUnitRank]=7,3,[GrpUnitRank] + 1)
WHERE  ([GrpUnitRank] Between 3 And 7)

Exactly as we'd want it to. And it worked perfectly every time.

[NeoPa]

AngelaIng:
I am in a hurry so I just read parts of your email but when I read the printed out version of the email I can see you asked for a copy of the code. By now I could have sent it to you. I will do both, send you a copy and try and figure it out on my own so I learn.

That's a very commendable attitude Angela, and I don't want to discourage you from anything that will help you learn. That said, I suspect we now have some working code for you so I doubt you'll need to send me anything for now.

If, after trying out the new code (Paste it into the module BTW. Retyping code is a reliable cause of introducing problems.), you find you still have problems then we can think again about sharing your code and/or your two databases.

I'm not expecting to hear back from you until after you come back ;-) Hurry off if you haven't gone already, but you can be quietly confident you'll get it working quickly and easily on your return.

[PhilOfWalton]

@Neopa

Elegant bit of coding as ever, the swap routine is beautifully concise.

However, on the sample Db, it appears that you can't add a new project (on the form) as the Undo looses the new record.

Phil

[NeoPa]

Indeed Phil, and thank you.

My solution was an exercise as specified by the question in this thread. If more is desired then that can be considered elsewhere. There is certainly information available to the code to allow differentiation between an addition and an update. I would expect any such design to add the [GrpUnitRank] value automatically as the number of records covered.

I don't believe such a discussion fits in this thread however.

[angelaing]

NeoPa. This meets the requirement perfectly. I have to do something similar to the same table updating the sequence basedv on the group unit rank entered for a new project enteted into a data entry form. I can conceptualize how I think it should work. This one I’m atill trying to understand why the .undo was needed.

[angelaing]

Excuse my mispellings. I’m typing on my phone and my eyes arent so good

[angelaing]

Responding to Phils comment. It’s ok because new records aren’t meant to be added on this form

[NeoPa]

AngelaIng:
This one I’m atill trying to understand why the .undo was needed.

That's because before .Undo() is called for the form the record is still dirty - IE. There is a change pending. It's back to the point just before you tab out of the Control. That is after the new value has been entered.

At this point both the Control and the form are dirty and so the record is locked. If we try to apply the UPDATE SQL when any of the records is dirty then the SQL will fail.