RecordCount After Delete

[gray]

Hi

OK, OK, is it April Fool's day already?

I have an ADODB RS based form. Amongst others it has :-
1. A unique autonum column "Unique_No"
2. "Field_Selected" column
3. 'List_Order' column
4. It has a .sort of "[Field_Selected] DESC,[TBL1.List_Order]"
. (Note: TBL1. table alias is because there is a JOIN).

List Order is, unsurprisingly, the order in which the records are displayed to the user

Users can select/de-select the [field_selected] col. When they do so I re-order the List_Order col. I do this by zooming down the RS and by adding 1 to the list order count. Or so I planned....

Because[List_Order] is used in the .Sort, the Index gets confused because when, say, Rec_A gets a new List_Order=2, Rec_D might already have a List_Order=2. .. upshot is that records get skipped and all the numbering gets out of sequence.

So... I first loop down the RS and set all the List_orders to 0 - (minus) their own value. This way they will not clash when re-numbered.

Set Prc_RstAdo = me.form.recordset.Clone
With Prc_RstADO_A
       .Sort = "" 'remove the sort
       .MoveFirst
        Do Until .EOF
                ![TBL1.List_Order] = (0 - ![TBL1.List_Order])
             .Update
             .MoveNext
        Loop

All is fine. BUT I then loop down them again to increment their List_Orders with + (positive) nos...

     Sort_Field = "[Field_Selected] DESC,[TBL1.List_Order] DESC"     'Note-Sorted on DESC here cos' of minus nos
     .Sort = Sort_Field     're-apply the sort
     .MoveFirst
     Do Until .EOF
            New_List_Order = New_list_order + 1             
            ![TBL1.List_Order] = New_list_order
            .Update
            .MoveNext
     Loop 
End With

For some infuriating reason, the second do-loop just continually goes around the [Field_Selected]=True records (which are all now at the top) So the .movenext just goes back to the beginning..... I guess when the current record gets it's new list_order, the RS automatically resorts itself and the cursor goes to a position further back?

Any ideas anyone please? Thnx.

 

[RainLover]

Do I understand this correctly.

Part A

You do some Sorting and Moving around the Recordset then assign a Value to "ListOrder"

Part B

You do some Sorting and Moving around the Recordset then assign a DIFFERENT Value to "ListOrder"

So why do Part A?

I must have missed something.

 

[gray]

May have cracked this one so please ignore... will add resolution when I've tested it... thnx

 

[RainLover]

I don't believe I helped much.

Cheers

 

[gray]

Hi

The whole problem arises because the column in the RS which is being updated is also the column on which it is being sorted.... so my fault really.

Having tried all sorts of clones and bookmarks I elected to use an array of the RS's key field nos.

 Dim New_List_Order As Long
Dim Rec_Unique_Nos() As String
Dim Rec_Unique_Nos_Cnt As Long 
 
me.painting = false ' switch off re-painting to avoid form flicker
 
With Me.Form.Recordset
   'Re-sort the form to capture any changes
   .Sort = Sort_Field
 
   'Create an array of Key Column numbers - these will be added to the array in the req'd order 
   .MoveFirst
   Do Until .EOF
      ReDim Preserve Rec_Unique_Nos(Rec_Unique_Nos_Cnt)
      Rec_Unique_Nos(Rec_Unique_Nos_Cnt) = ![TBL1.Unique_No]
      Rec_Unique_Nos_Cnt = UBound(Rec_Unique_Nos) + 1
     .MoveNext
   Loop
 
   'Remove the sort from the form for now or may not get consequetive nos
   .Sort = ""
 
   .MoveFirst
   'Now set list_orders to -minus numbers so they don't clash when re-numbered later
   Do Until .EOF
      ![TBL1.List_Order] = (0 - ![TBL1.List_Order])
      .Update
      .MoveNext
   Loop
 
   'Now cycle down the unique_nos array, find & re-number the List_Orders
   For Rec_Unique_Nos_Cnt = 0 To UBound(Rec_Unique_Nos)
      New_List_Order = New_List_Order + 1
      .Find "[TBL1.Unique_No]=" & Rec_Unique_Nos(Rec_Unique_Nos_Cnt), 0, adSearchForward, 1
      If .EOF Then
         MsgBox "can't find record"
         GoTo Err_Re_Order_Recordset
      Else
         ![TBL1.List_Order] = New_List_Order
         .Update
      End If
   Next Rec_Unique_Nos_Cnt
 
   'Add the sort back to the RS
   .Sort = Sort_Field
 
   'Reset Form RS to dislay latest order 
    Set Me.Form.Recordset = Me.Form.Recordset
 
   'Return to the record last selected by the user
   .Find "[TBL1.Unique_No]=" & Main_Rec_Unique_No, 0, adSearchForward, 1
End With
 
me.painting = true

Be careful with me.painting.... make sure it gets switched back on where there are errors or you'll be starting at the same screen until the end of time!


P.S. RainLover - thanks for the reply but all sorted now cheers?

 

[RainLover]

me.painting = true

Make sure this is added to your error handler.

If not then in case of an error it will remain False.

PS

Do you have "Option Explicit" Declared.

 

[gray]

Hi

Sorry for late reply.... yes I have Option Explicit and
Option Compare Text in all my modules.... thanks