Notes: How to re-order rows on a 'dynamic' table

If you have a 'dynamic' table where each column is composed by a multivalue field and you want to be able to change a row's position, then you can do it like this:

• Create a multivalue, computed for display field (hidden), named 'FldPos' with this formula:

@For(i:=1;i<=@Elements(fldProxiesName);i:=i +1;
sList:=sList : @Text(i)
);
@Trim(sList)

• Create a radio button field, named 'FldPosRB' and select "Use formula for choices" and then on the formula window type:

FldPos

• Then create two Buttons (or Action Hotspots), one called "Move Up" and another "Move Down".

The code for the first button is (for a 3 column table):

' moving up
Sub Click(Source As Button)
Dim ws As New notesuiworkspace
Dim uidoc As notesuidocument
Dim iCurPos As Integer

Dim vFinalList() As Variant
Dim vFinal1List() As Variant
Dim vFinal2List() As Variant

Dim vTemp As Variant

Dim sFieldSelection As String

Dim aFieldNames(2) As String

sFieldSelection = "FldPosRB"

aFieldNames(0)="FldMultivalue1"
aFieldNames(1)="FldMultivalue2"
aFieldNames(2)="FldMultivalue3"


Dim i As Integer

On Error Goto ErrorHandling

Set uidoc = ws.CurrentDocument


If Not isArrayInit(uidoc.document.GetItemValue(aFieldNames(0))) Then
Msgbox "The table is empty." , 64 , "Move up"
Exit Sub
End If

iCurPos =Cint(uidoc.document.getitemvalue(sFieldSelection)(0)) - 1

If iCurPos > 0 Then

For i=0 To Ubound (uidoc.Document.GetItemValue(aFieldNames(0)))
If i = iCurPos - 1 Then 'the position to move to
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(iCurPos)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(iCurPos)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(iCurPos)


Redim Preserve vFinalList (i + 1)
vFinalList(i + 1) = uidoc.Document.getitemvalue(aFieldNames(0))(i)
Redim Preserve vFinal1List (i + 1)
vFinal1List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(1))(i)
Redim Preserve vFinal2List (i + 1)
vFinal2List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(2))(i)


i = i + 1

Else
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(i)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(i)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(i)


End If
'vFinalList =
Next

Call uidoc.document.ReplaceItemValue(aFieldNames(0), vFinalList)
Call uidoc.document.ReplaceItemValue(aFieldNames(1), vFinal1List)
Call uidoc.document.ReplaceItemValue(aFieldNames(2), vFinal2List)

Call uidoc.Document.replaceitemvalue(sFieldSelection, iCurPos)
uidoc.Refresh
uidoc.refresh
End If

errorhandling:
If Err=9 Then 'subscript out of range, one column is empty
Resume Next
Elseif Err>0 Then
Msgbox "Error: " + Error
Goto EndThis
End If

EndThis:
End Sub

And to move down (logical differences in bold):

' moving down
Sub Click(Source As Button)
Dim ws As New notesuiworkspace
Dim uidoc As notesuidocument
Dim iCurPos As Integer

Dim vFinalList() As Variant
Dim vFinal1List() As Variant
Dim vFinal2List() As Variant
Dim sFieldSelection As String

Dim aFieldNames(2) As String

sFieldSelection = "FldPosRB"

aFieldNames(0)="FldMultivalue1"
aFieldNames(1)="FldMultivalue2"
aFieldNames(2)="FldMultivalue3"


Dim i As Integer

On Error Goto ErrorHandling

Set uidoc = ws.CurrentDocument

If Not isArrayInit(uidoc.document.GetItemValue(aFieldNames(0))) Then
Msgbox "The table is empty." , 64 , "Move down"
Exit Sub
End If

iCurPos =Cint(uidoc.document.getitemvalue(sFieldSelection)(0)) - 1


If iCurPos < i="0" style="font-weight: bold;">i = iCurPos Then
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(iCurPos + 1)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(iCurPos + 1)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(iCurPos + 1)



Redim Preserve vFinalList (i + 1)
vFinalList(i + 1) = uidoc.Document.getitemvalue(aFieldNames(0))(iCurPos)
Redim Preserve vFinal1List (i + 1)
vFinal1List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(1))(iCurPos)
Redim Preserve vFinal2List (i + 1)
vFinal2List(i + 1) = uidoc.Document.getitemvalue(aFieldNames(2))(iCurPos)



i = i + 1
Else
Redim Preserve vFinalList (i)
vFinalList(i) = uidoc.Document.getitemvalue(aFieldNames(0))(i)
Redim Preserve vFinal1List (i)
vFinal1List(i) = uidoc.Document.getitemvalue(aFieldNames(1))(i)
Redim Preserve vFinal2List (i)
vFinal2List(i) = uidoc.Document.getitemvalue(aFieldNames(2))(i)

End If
Next


Call uidoc.document.ReplaceItemValue(aFieldNames(0), vFinalList)
Call uidoc.document.ReplaceItemValue(aFieldNames(1), vFinal1List)
Call uidoc.document.ReplaceItemValue(aFieldNames(2),vFinal2List)


Call uidoc.Document.replaceitemvalue(sFieldSelection, iCurPos + 2)
uidoc.Refresh
uidoc.refresh
End If

errorhandling:
If Err=9 Then 'subscript out of range, one column is empty
Resume Next
Elseif Err>0 Then
Msgbox "Error: " + Error
Goto EndThis
End If

EndThis:
End Sub

Notes: Bubble Sorting a Document Collection

«Searching a database using db.ftsearch is pretty fast and efficient but ordering based on a field value in the documents is not possible. What is required is something akin to a SQL ORDER BY clause but alas we don't have one and have to resort to sorting the collection the old fashioned way... by implementing a bubble sort.

Usage

Dim vCollection As NotesDocumentCollection 

Set vCollection = vSearchDatabase.ftsearch(aQuery, 501, FT_SCORES, FT_FUZZY) 
Set vCollection = Global_SortCollection(vCollection, "Person_Surname")

The sort function requires two parameters, the first a NotesDocumentCollection with documents in it and the second a field name to use to sort the documents, in the example above the documentcollection "vCollection" will be sorted by "Person_Surname".

The function works by converting the document collection into an array of documents, doing a bubble sort on the array and then converting the array back into a new document collection.

The Code

Function Global_SortCollection(aCollection As NotesDocumentCollection, aField As String) As Variant 
 Dim vCollectionDB As NotesDatabase 
 Dim vDocTemp As NotesDocument 
 Dim vCollectionSorted As NotesDocumentCollection 
 Dim vDocArray() As String 
 Dim vLower As Integer
 Dim vUpper As Integer 
 Dim vBottomMax As Integer 
 Dim vLoop As Integer 
 Dim vLoopTopHalf As Integer 
 Dim vLoopBottomHalf As Integer 
 Dim vMidPoint As Integer 
 Dim vTarget As String 
 Set vCollectionDB = aCollection.Parent 
 Redim vDocArray(aCollection.count-1) As String 
'CONVERT DOCUMENT COLLECTION TO ARRAY 
 Let vLoop = 0 
 Set vDocTemp = aCollection.GetFirstDocument 
 Do While Not vDocTemp Is Nothing 
  vDocArray(vLoop) = vDocTemp.GetItemValue(aField)(0) + "~" + vDocTemp.UniversalID 
  Set vDocTemp = aCollection.GetNextDocument(vDocTemp) 
  vLoop = vLoop + 1 
 Loop
 'SHELL SORT THE ARRAY 
 vLower = Lbound( vDocArray( ) ) 
 vUpper = Ubound( vDocArray( ) ) 
 vMidPoint = 1 
'DETERMINE A STARTING MID POINT TO THE ARRRAY 
 Do
  vMidPoint = (3*vMidPoint) + 1 
 Loop Until vMidPoint > vUpper - vLower + 1
 'LOOP THROUGH THE ARRAY 
 Do 
  vMidPoint = vMidPoint \ 3 
  vBottomMax = vLower + vMidPoint - 1 
  For vLoopTopHalf = vBottomMax + 1 To vUpper 
   
   
   vTarget = vDocArray(vLoopTopHalf) 
   vLoopBottomHalf = vLoopTopHalf 
'COMPARE TOP HALF OF ARRAY WITH BOTTOM HALF 
   Do While vDocArray( vLoopBottomHalf - vMidPoint ) > vTarget
    vDocArray(vLoopBottomHalf) = vDocArray(vLoopBottomHalf - vMidPoint) 
    vLoopBottomHalf = vLoopBottomHalf - vMidPoint 
    If (vLoopBottomHalf <= vBottomMax) Then Exit Do 
   Loop 
   If (vLoopBottomHalf <> vLoopTopHalf) Then vDocArray(vLoopBottomHalf) = vTarget 
  Next 
 Loop Until vMidPoint = 1 
'CREATE A NEW EMPTY DOC COLLECTION 
 Set vCollectionSorted = vCollectionDB.Search("",Nothing,0) 
'CONVERT ARRAY TO DOC COLLECTION 
 For vLoop = 0 To Ubound(vDocArray) 
  Set vDocTemp = vCollectionDB.GetDocumentByUNID(Strrightback(vDocArray(vLoop), "~")) 
  Call vCollectionSorted.AddDocument(vDocTemp) 
 Next vLoop 
'RETURN THE DOCUMENT COLLECTION 
 Set Global_SortCollection = vCollectionSorted 
End Function 

Conclusion

A simple yet extremely useful function that belongs in everyone's global routines script library.»

(Source)

Notes - Web: Ajax Drag-n-Drop Sorting of Documents

«Imagine the following situation - say you've got a set of documents which are all children of one container document. From within this parent container document you want to be able to quickly change the order in which the child documents appear. Sound familiar?»

More >